I have 76 sheets where I need to perform a goal seek, so I'm attempting to get this to work in VBA... But I'm getting runtime errors. I have someone's account value in I3. Their final payment date is in I4. The spreadsheet looks up the final payment cell and puts it into I5, and I6 adjusts the cell value to show what cell we would want to "set to 0" to avoid having to constantly scroll when I was doing this manually.
I need to:
Set Cell: (value of I6)'
To Value: 0
By changing Cell: F4
Here is my most recent attempt that resulted in a runtime error. I've also attached my spreadsheet as an example. Any help would be greatly appreciated!
Goal Seek Macro.xlsm
Sub PerformGoalSeekOnSheets()
Dim ws As Worksheet
Dim targetCell As Range
Dim changingCell As Range
Dim targetCellAddress As String ' Store the address of the target cell
Dim colLetter As String ' Store the column part of the cell reference
Dim rowNumber As Long ' Store the row part of the cell reference
' Define the changing cell (F4) only once
Set changingCell = ThisWorkbook.Worksheets("TemplateSheet").Range("F4")
' Loop through each worksheet starting from the third sheet
For Each ws In ThisWorkbook.Worksheets
If ws.Index >= 3 Then
' Evaluate the formula in cell I6 to get the actual cell reference
targetCellAddress = ws.Range("I6").Value
' Print the value of cell I6 to the Immediate Window
Debug.Print "Value of cell I6 on worksheet '" & ws.Name & "': " & targetCellAddress
' Check if the target cell address is valid
If Not IsValidCellReference(targetCellAddress, colLetter, rowNumber) Then
MsgBox "Invalid cell reference in cell I6 on worksheet '" & ws.Name & "'. Skipping goal seek operation.", vbExclamation
Else
' Set the target cell using the column and row parts
Set targetCell = ws.Cells(rowNumber, colLetter)
' Perform goal seek
Application.GoalSeek Goal:=0, ChangingCell:=changingCell, _
ChangingCellFormula:=changingCell.Formula
End If
End If
Next ws
End Sub
Function IsValidCellReference(cellRef As String, ByRef colLetter As String, ByRef rowNumber As Long) As Boolean
Dim i As Integer
Dim colPart As String
Dim rowPart As String
Dim hasFoundNumeric As Boolean
' Initialize variables
colLetter = ""
rowNumber = 0
hasFoundNumeric = False
' Check if the cell reference is in the format of "COLROW" (e.g., "D5453")
If Len(cellRef) < 2 Then Exit Function
' Extract the column part (letters) and row part (numbers)
For i = 1 To Len(cellRef)
If Not hasFoundNumeric Then
If IsNumeric(Mid(cellRef, i, 1)) Then
colPart = Left(cellRef, i - 1)
rowPart = Mid(cellRef, i)
hasFoundNumeric = True
End If
End If
Next i
' Check if the column part is valid (A-Z or a-z)
If colPart Like "[A-Za-z]*" Then
colLetter = colPart
rowNumber = Val(rowPart)
IsValidCellReference = True
End If
End Function
Bookmarks