Multiple goalseek - pls pls help
 

Can someone pls correct my macro below regarding range address below
as macro does not want to run- thxs


Sub Multi_Goal_SeekRANGE()
Dim TargetVal As Range, DesiredVal As Range, ChangeVal As Range,
CVcheck As Range
Dim CheckLen As Long, i As Long

Let rgt = (Range("Column").Value)
Let Frz = 13 - (Range("Column").Value)
ActiveWorkbook.PrecisionAsDisplayed = False


restart:
With Application
Set TargetVal = Range("Setcell").Offset(0, rgt).Resize(1,
Frz).Address


Set DesiredVal = Range("Changedto").Offset(0, rgt).Resize(1,
Frz).Address


Set ChangeVal = Range("ByChanging").Offset(0, rgt).Resize(1,
Frz).Address


End With

'Ensure that the changing cell range contains only values, no
formulas allowed
Set CVcheck = Intersect(ChangeVal,
Union(Sheets(ChangeVal.Parent.Name).Cells.SpecialC ells(xlBlanks),
Sheets(ChangeVal.Parent.Name).Cells.SpecialCells(x lConstants)))
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