Goal Seek Macro - ignore blank cells in ranges

[elliotawin]

I have been using the following Macro to set prices for a given Profit on Return.
(sounds somewhat unnecessary as I could use a formula the other way around - however it is necessary and this is the favored way of doing things)
However with a list of products there is inevitably a subheading and therefore a gap in the Target Address (Taddr) and the Adjusted Rang (Aaddr) I am sure there is a simple solution to skip a blank cell in the For loop, but i can;t seem to find it!!! Any suggestions..

Sub GSeekA()
Dim ARange As range, TRange As range, Aaddr As String, Taddr As String, NumEq As Long, i As Long, j As Long
Dim TSheet As String, ASheet As String, NumRows As Long, NumCols As Long
Dim GVal As Double, Acell As range, TCell As range, Orient As String


' Create the following names in the back-solver worksheet:
' Taddr - Cell with the address of the target range
' Aaddr - Cell with the address of the range to be adjusted
' gval - the "Goal" value
' To reference ranges on different sheets also add:
' TSheet - Cell with the sheet name of the target range
' ASheet - Cell with the sheet name of the range to be adjusted


Aaddr = range("aaddr").Value
Taddr = range("taddr").Value


On Error GoTo NoSheetNames
ASheet = range("asheet").Value
TSheet = range("tsheet").Value


NoSheetNames:
On Error GoTo ExitSub
If ASheet = Empty Or TSheet = Empty Then
Set ARange = range(Aaddr)
Set TRange = range(Taddr)
Else
Set ARange = Worksheets(ASheet).range(Aaddr)
Set TRange = Worksheets(TSheet).range(Taddr)
End If


NumRows = ARange.Rows.Count
NumCols = ARange.Columns.Count


GVal = range("gval").Value


For j = 1 To NumCols
For i = 1 To NumRows

TRange.Cells(i, j).GoalSeek Goal:=GVal, ChangingCell:=ARange.Cells(i, j)

Next i
Next j
ExitSub:
End Sub

 

[skorpionkz]

try this:

For j = 1 To NumCols
For i = 1 To NumRows
If not cells(i,j) =empty then
TRange.Cells(i, j).GoalSeek Goal:=GVal, ChangingCell:=ARange.Cells(i, j)
End if
Next i
Next j

 

[elliotawin]

That is the solution I started with, it works for the first set of populated cells, then stops. i.e. AX434:AX438 even though the Adjusted Range is set to AX434:AX498 as there is a blank cell at AX439. There is no error function, it just stops.

 

[skorpionkz]

This should not stop the code. If it stopped check your NumCols and NumRows values.

 

[elliotawin]

I have checked, this still doesn't work...

 

[skorpionkz]

Can you upload sample file?

 

[elliotawin]

I can't, but i could email you a sample file?

 

[skorpionkz]

sure

 

[skorpionkz]

the problem is the GoalSeek there.

The "On Error GoTo ExitSub" caused that you don't have error message.

To be honest I don't know yet how to correct the GoalSeek to get it work correctly

 

[elliotawin]

SORTED!
For j = 1 To NumCols
For i = 1 To NumRows
If Not TRange.Cells(i, j) = Empty Then
TRange.Cells(i, j).GoalSeek Goal:=GVal, ChangingCell:=ARange.Cells(i, j)
End If
Next i
Next j