Find function loop with True and False outcomes

ckm102318

New Member
Joined
Sep 13, 2022
Messages
1
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
15,377
Office Version
  1. 365
Platform
  1. Windows
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.

VBA 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
 

Forum statistics

Threads
1,181,182
Messages
5,928,581
Members
436,608
Latest member
nevers0220

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top