Algebraic solution from system of symbolic equations for single variable

Combining the approaches by Daniel Huber and Roma Lee provides the desired answer more or less instantly.

eq = {K1 == c*h/d, K2 == b*h/c, K3 == a*h/b, C == a + b + c + d, h + d == W/h + b + 2 a};
sh = Solve[Eliminate[eq, {a, b, c, d}], h] // Flatten
(* {h -> Root[-K1 K2 K3 W + (-2 C K1 K2 K3 - K1 K2 W) #1 + (-C K1 K2 + 
    K1 K2 K3 - K1 W) #1^2 + (K1 K2 - W) #1^3 + (C + K1) #1^4 + #1^5 &, 1], ... *)

where " . . . " represents the other four roots. Then, solve for the other variables.

sabcd = Solve[Most@eq, {a, b, c, d}] // Flatten
(* {a -> (C K1 K2 K3)/(h^3 + h^2 K1 + h K1 K2 + K1 K2 K3), 
    b -> (C h K1 K2)/(h^3 + h^2 K1 + h K1 K2 + K1 K2 K3), 
    c -> (C h^2 K1)/(h^3 + h^2 K1 + h K1 K2 + K1 K2 K3), 
    d -> (C h^3)/(h^3 + h^2 K1 + h K1 K2 + K1 K2 K3)} *)

producing the desired result. A sample numerical result is

SeedRandom[1066];
test = Thread[{K1, K2, K3, C , W} -> RandomReal[{-5, 5}, 5]]
(* {K1 -> -0.198869, K2 -> -1.87425, K3 -> -0.429646, C -> -2.69173, W -> 0.774499} *)
sh /. test
Replace[sabcd /. test, List /@ %, Infinity]
(* {h -> -0.868514, h -> 0.118971, h -> 2.95534, 
    h -> 0.342404 - 0.537515 I, h -> 0.342404 + 0.537515 I} *)
(* {{a -> -0.334413, b -> -0.676002, c -> -0.313254, d -> -1.36807}, 
    {a -> -3.68652, b -> 1.02082, c -> -0.0647982, d -> 0.0387649}, 
    {a -> 0.0172311, b -> -0.118525, c -> 0.186891, d -> -2.77733}, 
    {a -> -1.20902 + 0.762827 I, b -> 0.00917872 - 2.12049 I, 
     c -> 0.606457 + 0.390022 I, d -> -2.09835 + 0.967645 I}, 
    {a -> -1.20902 - 0.762827 I, b -> 0.00917872 + 2.12049 I, 
     c -> 0.606457 - 0.390022 I, d -> -2.09835 - 0.967645 I}} *)

This numerical result can be verified quite simply, of course, by

Sort /@ NSolve[eq /. test, {h, a, b, c, d}]

This is how you would write this in MMA:

eq = {K1 == c*h/d,
   K2 == b*h/c,
   K3 == a*h/b,
   C == a + b + c + d,
   h + d == W/h + b + 2 a
   };
sol=Solve[eq, {h, a, b, c, d}]

MMA take severyl hours, but finally we get an output that is too lengthy to display here. I only give the answer for h:

h /. sol

{Root[-K1 K2 K3 W + (-2 C K1 K2 K3 - K1 K2 W) #1 + (-C K1 K2 + 
       K1 K2 K3 - K1 W) #1^2 + (K1 K2 - W) #1^3 + (C + 
       K1) #1^4 + #1^5 &, 1], 
 Root[-K1 K2 K3 W + (-2 C K1 K2 K3 - K1 K2 W) #1 + (-C K1 K2 + 
       K1 K2 K3 - K1 W) #1^2 + (K1 K2 - W) #1^3 + (C + 
       K1) #1^4 + #1^5 &, 2], 
 Root[-K1 K2 K3 W + (-2 C K1 K2 K3 - K1 K2 W) #1 + (-C K1 K2 + 
       K1 K2 K3 - K1 W) #1^2 + (K1 K2 - W) #1^3 + (C + 
       K1) #1^4 + #1^5 &, 3], 
 Root[-K1 K2 K3 W + (-2 C K1 K2 K3 - K1 K2 W) #1 + (-C K1 K2 + 
       K1 K2 K3 - K1 W) #1^2 + (K1 K2 - W) #1^3 + (C + 
       K1) #1^4 + #1^5 &, 4], 
 Root[-K1 K2 K3 W + (-2 C K1 K2 K3 - K1 K2 W) #1 + (-C K1 K2 + 
       K1 K2 K3 - K1 W) #1^2 + (K1 K2 - W) #1^3 + (C + 
       K1) #1^4 + #1^5 &, 5]}

Try

eqs = {K1 == c*h/d, K2 == b*h/c, K3 == a*h/b, C == a + b + c + d, h + d == W/h + b + 2 a};
Eliminate[eqs,{a,b,c,d}]

to get, e.g., the equation for h.