VBA Macro Won't Loop correctly

[DJMXM]

Good Morning Everyone - I have been working on a Maco that no matter which way I set the after:=wsSource.Range - Either ("AI90" or "AI94") all I get is one entry copied even tho there are more than one items that set to TRUE.

The Macro won't loop an find all items. Thank You in advance for your help!!

Sub BEOA9()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim FoundX As Range
    Dim FirstFound As String
    Dim Lastrow As Long
    
    Application.ScreenUpdating = False
    
    Set wsSource = Worksheets("Catering and Rental Worksheet")
    Set wsDest = Worksheets("Catering BEO")

' Food Manual Input Section
Set FoundX = wsSource.Range("AI90:AI94").Find(What:="TRUE", after:=wsSource.Range("AI90"), _
                                        LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
    If FoundX Is Nothing Then
        Exit Sub
    Else
        FirstFound = FoundX.Address
        Lastrow = wsDest.Range("O" & Rows.Count).End(xlUp).Row + 1
        If Lastrow < 3 Then Lastrow = 3
        Do
            wsDest.Range("O" & Lastrow).Resize(1, 6).Value = FoundX.Offset(0, -7).Resize(1, 6).Value
            Set FoundX = wsSource.Range("AI90:AI94").FindNext(FoundX)
        Loop Until FoundX.Address = FirstFound
End If
End Sub

 

[JLGWhiz]

See if this will work:

Sub BEOA9()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim FoundX As Range
    Dim FirstFound As String
    Dim Lastrow As Long
    Application.ScreenUpdating = False
    Set wsSource = Worksheets("Catering and Rental Worksheet")
    Set wsDest = Worksheets("Catering BEO")
' Food Manual Input Section
Set FoundX = wsSource.Range("AI90:AI94").Find(What:="TRUE", after:=wsSource.Range("AI89"), _
                LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
    If FoundX Is Nothing Then
        Exit Sub
    Else
        FirstFound = FoundX.Address
        Lastrow = wsDest.Range("O" & Rows.Count).End(xlUp).Row + 1
        If Lastrow < 3 Then Lastrow = 3
        Do
            wsDest.Range("O" & Lastrow).Resize(1, 6).Value = FoundX.Offset(0, -7).Resize(1, 6).Value
            FoundX.Value = "TRUE"
            Set FoundX = wsSource.Range("AI90:AI94").FindNext(FoundX)
        Loop Until FoundX.Address = FirstFound
End If
End Sub

 

[DJMXM]

Thank you for your help... Unfortunately that did Not do the trick. It still only returns one item to the destination

Mike

 

[JLGWhiz]

I should have caught it the first time. The Last row statements are in the wrong place. Move them as shown. Aslo, you do not need the After: parameter in your find statement since the range is defined. VBA will automatically check each cell in the defined range.

Sub BEOA9()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim FoundX As Range
    Dim FirstFound As String
    Dim Lastrow As Long
    Application.ScreenUpdating = False
    Set wsSource = Worksheets("Catering and Rental Worksheet")
    Set wsDest = Worksheets("Catering BEO")
' Food Manual Input Section
Set FoundX = wsSource.Range("AI90:AI94").Find(What:="TRUE", _
                LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
    If FoundX Is Nothing Then
        Exit Sub
    Else
        FirstFound = FoundX.Address
        Do
        Lastrow = wsDest.Range("O" & Rows.Count).End(xlUp).Row + 1
            If Lastrow < 3 Then Lastrow = 3
            wsDest.Range("O" & Lastrow).Resize(1, 6).Value = FoundX.Offset(0, -7).Resize(1, 6).Value
            FoundX.Value = "TRUE"
            Set FoundX = wsSource.Range("AI90:AI94").FindNext(FoundX)
        Loop Until FoundX.Address = FirstFound
End If
End Sub

 

[DJMXM]

THANK YOU!!!!!!!!!!!!!!!!!!!!!!!! After more than 20 hours of fooling around with it and reading internet posts until my eyes are red it finally works!!! You are FANTASTIC!!! Thank You!!!!

Mike

 

[Teeroy]

Hi DJMXM,

JLGWhiz has solved the problem but not explained what was wrong with your code (since you've said you're in information overload I thought I'd break it down). You were in fact finding all matches but since you set lastrow outside the loop structure each item found was being (over)written to the same location so it looked like you were only finding the last match.

 

[JLGWhiz]

Glad you got it working,
Regards, JLG