VB with Solver Macro

[AlmostSmart]

I'm new to VB programming...I'm trying to write a macro that will go down a column to the last cell with numbers...then set that cell to zero. Goal seek will then find the largest possible value for a third cell that would still make the fore mentioned cell zero. Here is what I have so far:

Sub fcol()
'
' fcol Macro
' Macro recorded 7/15/2002
'

'


Range("B9:B1104").Select

Range(ActiveCell, ActiveCell.End("End")).Select

ActiveCell.GoalSeek Goal:=0, ChangingCell:=Range("H8")

End Sub

Of course this doesn't work, any suggestions would be greatly appreciated.
Thanks.

[NoName]

GoalSeek doesn't work presumably because the target cell is already zero. I don't know the context of your problem but I can see three possible ways out:

1. Write your own macro as an equivalent of GoalSeek that will split the search range in half each time (assuming that the result range is well-behaved for changes in the changing cell, so you can always tell whether to increase or decrease your guess) - in pseudocode (untested)


lo = 10 '''definitely works
hi = 50 '''definitely doesn't
do while hi - lo > 0.00001
middle = (hi + lo) / 2
changingcell = middle
if stillzero then
lo = middle
else
hi = middle
endif
loop

2. Put a formula in another cell that would be suitable for GoalSeeking (e.g. that will decrease to zero as the target cell comes closer and closer to no longer being zero - again, if that makes sense in the context of the behavior of the cells)
3. See if the Solver add-in would be more useful

[Hedges]

Hello AlmostSmart

I’m not sure I understand your problem (what do you want to do the goal seek once you have set the last cell to zero?) - but that never stopped me from giving bad advice. Here’s some code which will find the last numeric item in a column and set it to zero. As written, the code will check for both cells containing constants and cells containing formulae with numeric results and set the last of either to zero. However it should be easy enough to change the code to set just numeric constants to zero.

The argument passed to the the SetToZero routine (cell B5 in the example) is the cell at the top of the column.

Hope this helps
Hedges

[Edited code to find the last cell!]

Sub Test()
Call SetToZero(ActiveSheet.Range("B5"))
End Sub


Sub SetToZero(rng As Range)

Dim c_rng As Range 'range containing numeric constants
Dim f_rng As Range 'range containing formula having numeric results
Dim cmbd_rng As Range 'range containing union of the above two
Dim last_rng, last_cell As Range 'last range in the union and last cell in the last range


If IsEmpty(rng) Then
Exit Sub
ElseIf Not IsEmpty(Cells(rng.Row + 1, rng.Column)) Then
'resets sets range to be the entire column where
'where the top cell is the initial 'rng' cell.
Set rng = rng.Parent.Range(Cells(rng.Row, rng.Column), Cells(rng.Row, rng.Column).End(xlDown))
End If


'On Error needed in case no constants or formulas,
'as special cells method will return an error message
On Error Resume Next
Set c_rng = rng.SpecialCells(xlCellTypeConstants, xlNumbers)
Set f_rng = rng.SpecialCells(xlCellTypeFormulas, xlNumbers)
On Error GoTo 0

'Union only works if both ranges are not empty, so check first!
If c_rng Is Nothing And f_rng Is Nothing Then 'nothing found!
Exit Sub
ElseIf c_rng Is Nothing Then 'no numeric constants, only formula
Set cmbd_rng = f_rng
ElseIf f_rng Is Nothing Then 'no formula, only numeric constants
Set cmbd_rng = c_rng
Else
Set cmbd_rng = Union(c_rng, f_rng)
End If

Set last_rng = cmbd_rng.Areas(cmbd_rng.Areas.Count) 'Find the last range in the combined area
Set last_cell = last_rng.Cells(last_rng.Cells.Count) 'Find the last range in the combined area
last_cell.Select
last_cell = 0

Set c_rng = Nothing
Set f_rng = Nothing
Set cmbd_rng = Nothing
Set last_rng = Nothing
Set last_cell = Nothing

End Sub