Multiple Goal Seek Code - Only Solves the First Row

[Niun]

Hi! I am trying to utilize some code for multiple cell goal seek. It allows you to select the set cells, cells that will be changed to, and the cells that will change. However it only works on the first row . The code is below, I am using excel 2007.

Option Explicit
Sub Multi_Goal_Seek()
Dim TargetVal As Range, DesiredVal As Range, ChangeVal As Range, CVcheck As Range
Dim CheckLen As Long, i As Long

restart:
With Application
Set TargetVal = .InputBox(Title:="Select a range in a single row or column", _
prompt:="Select your range which contains the ""Set Cell"" range", Default:=Range("C11:E11").Address, Type:=8)
'no default option
'prompt:="Select your range which contains the ""Set Cell"" range",, Type:=8)
Set DesiredVal = .InputBox(Title:="Select a range in a single row or column", _
prompt:="Select the range which the ""Set Cells"" will be changed to", Default:=Range("C12:E12").Address, Type:=8)
'no default option
'prompt:="Select the range which the ""Set Cells"" will be changed to",, Type:=8)
Set ChangeVal = .InputBox(Title:="Select a range in a single row or column", _
prompt:="Select the range of cells that will be changed", Default:=Range("G8:G10").Address, Type:=8)
'no default option
'prompt:="Select the range of cells that will be changed",, Type:=8)
End With

'Ensure that the changing cell range contains only values, no formulas allowed
Set CVcheck = Intersect(ChangeVal, Union(Sheets(ChangeVal.Parent.Name).Cells.SpecialCells(xlBlanks), Sheets(ChangeVal.Parent.Name).Cells.SpecialCells(xlConstants)))
If CVcheck Is Nothing Then
MsgBox "Changing value range contains no blank cells or values" & vbNewLine & _
"Goal seek only works if the cells to be changed are values, please ensure that this is the case", vbCritical
Application.GoTo reference:=DesiredVal
Exit Sub
Else

If CVcheck.Cells.Count <> DesiredVal.Cells.Count Then
MsgBox "Changing value range contains formulas" & vbNewLine & _
"Goal seek only works if the cells to be changed are values, please ensure that this is the case", vbCritical
Application.GoTo reference:=DesiredVal
Exit Sub
End If
End If

'Ensure that the amount of cells is consistent
If TargetVal.Cells.Count <> DesiredVal.Cells.Count Or TargetVal.Cells.Count <> ChangeVal.Cells.Count Then
CheckLen = MsgBox("Ranges were different lengths, please press yes to re-enter", vbYesNo + vbCritical)
If CheckLen = vbYes Then
'If ranges are different sizes and user wants to redo then restart code
GoTo restart
Else
Exit Sub
End If
End If

' Loop through the goalseek method
For i = 1 To TargetVal.Columns.Count
TargetVal.Cells(i).GoalSeek Goal:=DesiredVal.Cells(i).Value, ChangingCell:=ChangeVal.Cells(i)
Next i
End Sub

[p45cal]

Take a look here: http://stackoverflow.com/questions/1...cro-code-error
where the suggestion is to alter:
For i = 1 To TargetVal.Columns.Count
to:
For i = 1 To TargetVal.Rows.Count

I don't know how your data are arranged so this may need changing to:
For i = 1 To TargetVal.cells.Count
instead.

If none of these work, then supply a sample workbook with source data and desired results.

[Niun]

p45cal,

For i = 1 To TargetVal.Rows.Count

That did the trick. Code working as intended now. Thank you so much.