VBA Find Method problem

[mark1]

Been racking my brain on this one and I don't know why it
hasn't worked.

I'm using the Find method in my VBA query to find cells
that contain the value "Rank", then does an operation on
the cells below it. Then it moves to the next page and
does the same thing. Unfortunately, if there are two
cells with the value "Rank" on one page, the code will
only look at the first one, do the operation, then go to
the next page. This is the basic code. I've tried a For
Each... Next loop right above the find method, but can't
seem to get it to work. I've also tried an If... Then
statement.

Do Until ActiveSheet.Name = "GLInputM"

Cells.Find("Rank", , xlValues).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Range("A1:A36").Select
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1:A36").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Application.CutCopyMode = False

If Not ActiveSheet.Next Is Nothing Then
ActiveSheet.Next.Activate
End If
Loop

What I don't understand is why I can't put this:

If Cells.Find("Rank", ActiveCell, xlValues) = True then
Cells.Find("Rank",ActiveCell,xlValues).Activate
ActiveCell.Offset(1,0)...so on and so forth

Right above my "If Not ActiveSheet.Next Is Nothing Then"
line.

Help is greatly appreciated!!!!

 

[Bernie Deitrick]

Marks,

You need to step through to find the cells one by one, and you need to check
that you haven't backtracked back to the first cell.

The sub below will convert the 36 cells below any cell with "Rank" to
values, for all sheets in the activeworkbook.

HTH,
Bernie
MS Excel MVP

Sub ConvertCellsBelowRankOnAllSheets()
Dim c As Range
Dim myFindString As String
Dim firstAddress As String
Dim mySht As Worksheet

myFindString = "Rank"

For Each mySht In ActiveWorkbook.Worksheets
With mySht.Cells

Set c = .Find(myFindString, LookIn:=xlValues, lookAt:=xlWhole)

If Not c Is Nothing Then
firstAddress = c.Address
c.Offset(1, 0).Resize(36, 1).Value = _
c.Offset(1, 0).Resize(36, 1).Value
Else
GoTo NotFound:
End If

Set c = .FindNext(c)
If Not c Is Nothing And c.Address <> firstAddress Then
Do
c.Offset(1, 0).Resize(36, 1).Value = _
c.Offset(1, 0).Resize(36, 1).Value
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
NotFound:
Next mySht

End Sub