Infinite loop with .Find method - vba

Question

I am trying to write a VBA script to automate moving things around in an spreadsheet that has a balance sheet imported from an accounting software.
The values on imported balance sheet start at row 5, column A has some text describing what the values of each row mean, and columns B and D have the amounts for each item.
The subtotals for each section and subsection of the balance sheet are on columns C and E. Each subtotal has is in a cell formatted with a solid upper border.
I would like to bring all these subtotals to the same columns as the values (i.e, columns B and D). I've tried to do this using the .Find method to search for cells with the specific format (cells with an upper border) and a Do loop to keep searching until I find all cells that should have a subtotal in it.
Notes:
I didn't use FindNext because it seems that it ignores format settings used in the preceding Find method, as described here.
I tried to used the FindAll function described by Tushar Mehta to go around this problem with FindNext, but it didn't find all cells with the specified format.
Here's the code. Any help is greatly appreciated!
Sub FixBalanceSheet()
Dim LookFor As Range
Dim FoundHere As String 'Address of the cell that should contain a subtotal
Dim beginAt As Range, endAt As Range, rng As Range 'Set the ranges for the sum to get the subtotal
Dim place As String 'String with the address of a cell that will contain a subtotal
Dim WhereToLook As Range 'Range where subtotals are to be found
'Set workbook and worksheet
With Sheets("Sheet1")
Set WhereToLook = Range("A5:F100")
'Every cell containing a subtotal has an upper border. So, look for cells containing border!
With Application.FindFormat.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
'Call search using .Find
Set LookFor = WhereToLook.Find(What:="", After:=Cells(5, 2), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
If Not LookFor Is Nothing Then 'Test if a cell with a bottom border is found
'What happens when a subtotal cell is found:
FoundHere = LookFor.Address
Debug.Print "Found at: " & Found
'Loop to set a range, sum values and put them in the right cell
Do
'% find out a range to calculate subtotals and put the value in the right cells %'
'Call for next search
With Application.FindFormat.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Set LookFor = WhereToLook.Find(What:="", After:=endAt, SearchFormat:=True)
Debug.Print "LookFor now is: " & LookFor.Address
Rem If LookFor.Address = Found Then ' Do not allow wrapped search
Rem Exit Do
Rem End If
Loop Until LookFor Is Nothing Or LookFor.Address = FoundHere ' Do not allow wrapped search
End If
End With
End Sub

Answer 1

Consider using a range object to loop through your range. You can add a total if you need a grand total, but this is probably an easier way than trying to select all cells that have formatting.
For example:
Sub TestStackOverflowCode()
Dim r As Range
Dim rngToChk As Range
'This is where you'd insert WhereToLook
Set rngToChk = ActiveSheet.Range("B1:B4")
For Each r In rngToChk
'If the top edge does not NOT have a border
If r.Borders(xlEdgeTop).LineStyle <> xlNone Then
'Copy the cell value to two cells to the right
r.Offset(, 2).Value = r.Value
End If
Next r
End Sub

Answer 2

I would recommend going back to the Range.Find/Range.FindNext method. There were some holes in your logic conditions and I believe I've adjusted them.
Set LookFor = WhereToLook.Find(What:="", After:=Cells(5, 2), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
If Not LookFor Is Nothing Then 'Test if a cell with a bottom border is found
'What happens when a subtotal cell is found:
FoundHere = LookFor.Address
Debug.Print "Found at: " & FoundHere
'Loop to set a range, sum values and put them in the right cell
Do
'do something with LookFor as a Range Object here
'Call for next search
Set LookFor = WhereToLook.FindNext(After:=LookFor) '<~~ look for next after current cell
Debug.Print "LookFor now is: " & LookFor.Address
Loop Until LookFor.Address = FoundHere ' Do not allow wrapped search (LookFor will never be nothing here)
End If

Answer 3

The findNext may not have worked if
you had [FindFormat.Borders...] after the [Set LookFor = WhereToLook.Find(...]
I do think ThreeTrickPony's answer is more elegant, but in general I'd suggest finding an alternative way to identify cells rather than formatting.