Just trying to loop this. Already works but manual

[hitbid]

Hi, Just working on a random process to improve, and I am simply not used to looping enough to be able to integrate it. Hoping someone might be able to help.

The code below is currently working, if I run it manually step by step.
I start in A1.
I then find the first "br :", and copy it, and then move down cells. Sub FindBR()
Then the AutoFill subroutine will call the Finding_Bottom_and_Top, and paste what I need where I need.

Once done, I have to go back to the FindBR routine, then go back to the AutoFill. I keep repeating this until it finally errors out around row 5000.

---

Dim BottomRow As Long
Dim TopRow As Long




Sub Finding_Bottom_And_Top()
    Selection.End(xlDown).Select
    BottomRow = Selection.Row
    Selection.End(xlUp).Select
    TopRow = Selection.Row
End Sub


Sub Start()
Range("A1").Select
End Sub


Sub FindBR()
Cells.Find(What:="br :", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        Selection.Copy
        Selection.End(xlDown).Select
End Sub


Sub AutoFill()
    Call Finding_Bottom_And_Top
    ActiveCell.Offset(0, -1).Range("A1").Select
    ActiveSheet.Paste
    Selection.AutoFill Destination:=Range("A" & TopRow & " :A" & BottomRow), Type:=xlFillCopy
End Sub

 

[hitbid]

I kept searching.

I consolidated FindBR and AutoFill into this:

Sub FindBR()

Cells.Find(What:="Br :", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        Selection.Copy
        Selection.End(xlDown).Select
        
        Call Finding_Bottom_And_Top
        ActiveCell.Offset(0, -1).Range("A1").Select
        ActiveSheet.Paste
        Selection.AutoFill Destination:=Range("A" & TopRow & " :A" & BottomRow), Type:=xlFillCopy
        Selection.End(xlDown).Select
End Sub

Then I created this little looping script here. I went and counted the number of instances of data that I was looking for, which will tell me how many times to repeat the loop.

Sub LastCellInColumn()Dim LastCell As Long
Dim iVal As Integer
    Range("B900000").End(xlUp).Select
    LastCell = Selection.Row
    iVal = Application.WorksheetFunction.CountIf(Range("B1:B" & LastCell), "*Br :*")
    'MsgBox iVal
    
    For i = 1 To iVal
    FindBR
    Next i
        
End Sub

This....seems to work!!!