Oops! -Forgot to insert CellRef vars...

Sub DAL2()
Dim sByChange As String, sCurCol As String
Dim sCRef1 As String, sCRef2 As String, sCRef3 As String, sCRef4 As
String
Dim sCSet1 As String, sCSet2 As String, vSz As Variant
Const sCol_List As String = "F,G,H,I,J,K,L,M,N" '//edit to suit

sByChange = "$E$10,$E$14,$E$28,$E$29,$E$41"
sCRef1 = "$E$37": sCRef2 = "$E$38": sCRef3 = "$E$47": sCRef4 =
"$E$48"
sCSet1 = "$E$25": sCSet2 = "$E$48"
sCurCol = "E"

For Each vSz In Split(sCol_List, ",")
SolverOk SetCell:=sCSet1, MaxMinVal:=3, ValueOf:="0", _
ByChange:=sByChange
SolverAdd CellRef:=sCRef1, Relation:=2, FormulaText:="0"
SolverOk SetCell:=sCSet1, MaxMinVal:=3, ValueOf:="0", _
ByChange:=sByChange
SolverAdd CellRef:=sCRef2, Relation:=2, FormulaText:="0"
SolverOk SetCell:=sCSet1, MaxMinVal:=3, ValueOf:="0", _
ByChange:=sByChange
SolverAdd CellRef:=sCRef3, Relation:=2, FormulaText:="0"
SolverOk SetCell:=sCSet2, MaxMinVal:=3, ValueOf:="0", _
ByChange:=sByChange
SolverAdd CellRef:=sCRef4, Relation:=2, FormulaText:="0"
SolverOk SetCell:=sCSet2, MaxMinVal:=3, ValueOf:="0", _
ByChange:=sByChange
SolverSolve

'Reset to next column
sByChange = Replace(sByChange, sCurCol, vSz)
sCSet1 = Replace(sCSet1, sCurCol, vSz)
sCSet2 = Replace(sCSet2, sCurCol, vSz)
sCRef1 = Replace(sCRef1, sCurCol, vSz)
sCRef2 = Replace(sCRef2, sCurCol, vSz)
sCRef3 = Replace(sCRef3, sCurCol, vSz)
sCRef4 = Replace(sCRef4, sCurCol, vSz)
sCurCol = vSz
Next
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc