Find function loop with True and False outcomes

[ckm102318]

I have a loop that searches for a "False" outcome where two columns are being compared. If it finds a false outcome it will create a space in the column with the missing information by cutting and moving the column down one cell. It should continue to do this until all of the false outcomes have been resolved.
The issue I am running into is that when it reaches the bottom and there is nothing to copy because it is the last row that is false it stops and gives an error.
I need to add to this to say that if it gives this error to do something else (which would just be to go over one cell to the left and copy and paste back in the empty cell).
The called out line of ActiveSheet.Paste is where it is stopping at.

lr = Range("B" & Rows.Count).End(xlUp).Row
Dim r As Range
Set r = Range("E:E").Find(what:="FALSE", After:=ActiveCell, LookIn:=xlValues)


With Worksheets("GL Detail2").Range("E:E").Select



If Not r Is Nothing Then
firstAddress = r.Address

Do
Selection.Find(what:="FALSE", After:=ActiveCell, LookIn:=xlValues, _
lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate

ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, -1).Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
ActiveCell.PasteSpecial
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0

End With

Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E" & lr)
Range("E2:E" & lr).Select
Selection.FindNext(After:=ActiveCell).Activate

Worksheets("GL Detail2").Range("E:E").Select


Loop While Not r Is Nothing


End If
End With

End Sub

 

[jasonb75]

There are a lot of things in your code that appear to serve no purpose, the continuous use of selection to move around the sheet makes it almost impossible to keep track of which cell any given line of the code refers to.

I've tried to trim off the excess fat and get it doing what you want it to, but your code was very difficult to follow with the description provided and no visual example of the starting layout or expected final result so I would expect some changes to be needed. I should also point out that the first line of your code is missing so it is not clear if you have posted all of your code or just a small part of it. If it is only a small part then the rest of it could play a significant role in how well this works as I have not been able to allow for it whilst making the changes below.

***IMPORTANT BIT***
To avoid potential data loss or a totally messed up sheet, please create a duplicate copy of your workbook for testing this code.

Option Explicit
Sub test()
Dim lr As Long, r As Range
lr = Cells(Rows.Count, 4).End(xlUp).Row
Dim FirstCell As Range, rFound As Range
Set FirstCell = Range("E:E").Find(what:="FALSE", After:=Range("E1"), LookIn:=xlValues, _
                lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                MatchCase:=True, SearchFormat:=False)

If Not FirstCell Is Nothing Then
    Set rFound = FirstCell
    Do
        
        If Not rFound Is Nothing Then
            With rFound
                If .Row = lr Then
                    Range(Cells(.Row, -1), Cells(lr, -1)).Cut .Offset(-1, 1)
                Else
                    .Offset(-1, -2).Copy .Offset(-1, -1)
                
                    With .Offset(-1, -1).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 65535
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                End If

            End With
        End If
            Set rFound = Range("E:E").FindNext(rFound)

    Loop Until rFound.Address = FirstCell.Address

End If
End Sub