Multiple Goalseek - Range

T

transferxxx

Could anybody pls correct first part of macro macro below (problem
with defining the range- as i tried to modify an existing macro) -
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

Let Change = Range("Changedto").Offset(0, rgt).Resize(1, Frz)
Let Setc = Range("Setcell").Offset(0, rgt).Resize(1, Frz)
Let Bychg = Range("ByChanging").Offset(0, rgt).Resize(1, Frz)


restart:
With Application
Set TargetVal = Setc.Address

Set DesiredVal = Change.Address

Set ChangeVal = Bychg.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.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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top