Hi

First a few comments on your code:

You set MyRange to last cell in column A only, so no cells to iterate on.
In your macro you search for 'Inmate Account-Institution Business Office'
but in the sample data the text is 'Account-Institution Business Office', I
am not sure what is correct, so I used the laste in the macro.
Once a match is found, your code will overwrite the cell value, use 'Offset'
to select another cell.

I changed the macro according to the comments above, and removed the test
for 'Total'.

Sub B9SHOP()
'
' SHOP Macro
' Macro recorded 2/25/2010 by hintzSA
'

'
Dim MyRange As Range
Dim EndRow As Long
Dim f As Range
Dim fFound As Range

EndRow = Range("A65536").End(xlUp).Row
Set MyRange = Range("A1:A" & EndRow)

Set f = MyRange.Find(What:="Account-Institution Business Office:", after:= _
Range("A1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Set fFound = f
Do
f.Offset(1, 0).FormulaR1C1 =
"=VLOOKUP(Payroll!R[3]C,Address!R2C1:R21C4,2,FALSE)"
Set f = MyRange.FindNext(after:=f)
Loop Until f.Address = fFound.Address
End Sub

Hopes this helps.
....
Per

"stacia" skrev i meddelelsen
...
I need help with this macro - does not work. What am I doing wrong? I
listed
an example of before and one as after to show you the results I want.
Additional note: everytime i use this macro, the amount of rows will never
be
the same. Lookup table is on sheet 2 for OFFICE and SHOP

Sub B9SHOP()
'
' SHOP Macro
' Macro recorded 2/25/2010 by hintzSA
'

'
Dim MyRange As Range
Dim MyCell As Range
Dim Endrow As Integer
Endrow = Range("A65536").End(xlUp).Row
Set MyRange = Range("A" & Endrow)
MyRange.Select
For Each MyCell In MyRange
If MyCell.value = "Total" Then
Cells.Find(What:="Inmate Account-Institution Business Office:",
After:= _
ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart,
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=False).Activate
ActiveWindow.SmallScroll down:=4

ActiveCell.FormulaR1C1 =
"=VLOOKUP(Payroll!R[3]C,Address!R2C1:R21C4,2,FALSE)"
End If
Next



End Sub




BEFO


BCE Pay Period 05 ending 02/27/10

Account-Institution Business Office: Shop Report

DEPT ADDRESS
883 Joe's
883 Joe's

883 Total

----------------------------------------------------------
Account-Institution Business Office: Shop Report


DEPT ADDRESS

887 dick's ink
887 dick's ink

887 Total $- 0

----------------------------------------------------------
Account-Institution Business Office: Shop Report

DEPT ADDRESS
893 RGCI
893 RGCI
893 RGCI

Grand Total $- 0


AFTER

BCE Pay Period 05 ending 02/27/10

Account-Institution Business Office: Shop Report
JOE'S FURNITURE - LACROSSE 883

DEPT ADDRESS

883 Joe's
883 Joe's
883 Total

---------------------------------------------------------------
Account-Institution Business Office: Shop Report
DICK AND JANE'S PAPER & INK 887

DEPT ADDRESS

887 dick's ink
887 dick's ink
887 Total

-----------------------------------------------------------------
Account-Institution Business Office: Shop Report
REDGRANITE GRAND CAPITAL INC 893

DEPT ADDRESS

893 RGCI
893 RGCI
893 RGCI


--
Stacia