VBA to compare two text box inputs and loop through results, deleting matches

[LCTrucido]

Hi Folks,

First, disclaimer. I'm not good with VBA at all but I can generally Google the beejeebers out of what I'm trying to do and eventually piece it together from info on forums like this. That's where the bulk of the following comes from but now I'm pretty well stuck.

I have a userform on sheet "Macros" with two text boxes and a button.

The userform is Delete_Transaction_Userform
The text boxes are Truck_TextBox and Stop_TextBox.

Clicking the button runs the following code which should take the input from Truck_Textbox and search column J in my second sheet, "Pick Input". When it finds a match it should compare the input in Stop_Textbox to the contents of the cell in column K. If both inputs match, the (always empty) row below and the row containing the match should be deleted, and the search should continue for another match.

Option Explicit

Sub Remove_Transaction()
    Dim TruckSearch As String
    Dim StopSearch As String
    Dim aCell As Range


    On Error GoTo Err


    Application.ScreenUpdating = False


    Worksheets("Pick Input").Activate


        'Get the values to search for from the userform text boxes
        TruckSearch = Delete_Transaction_Userform.Truck_TextBox.Value
        StopSearch = Delete_Transaction_Userform.Stop_TextBox.Value


        'Find a match for the Truck textbox in column J
        Set aCell = Columns(10).Find(What:=TruckSearch, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)


            'If a match is found then confirm the cell in column K also matches the input Stop textbox
            If Not aCell Is Nothing And aCell.Offset(0, 1) = StopSearch Then
            
                Do
                    'Delete the row found and the one below it until no more matches are found
                    aCell.Offset(1, 0).EntireRow.Delete
                    Rows(aCell.Row).Delete
                Loop While Not aCell Is Nothing And aCell.Offset(0, 1) = StopSearch
            Else 'If not found
                MsgBox "Transaction not Found"
            End If
            
            'When all matches are deleted
            MsgBox "Transaction Removed"
               
    Worksheets("Macro").Activate
    
    Application.ScreenUpdating = True
               
    Exit Sub
Err:
    MsgBox Err.Description
        
End Sub

Example:

1	1
1	2
1	2

<tbody>
</tbody>

If I run the macro with input 1 and 1, it should delete the first two rows. I get an object required error but it does delete those rows first. If I were to run it with input 1 and 2, I get the message "Transaction not Found", then "Transaction Removed", but nothing actually gets deleted.

I'm out of my depth, any thoughts?

 

[LCTrucido]

Ok, I've got another solution that almost works, it just doesn't loop until it's completely finished, and sometimes it doesn't find the row at all and skips the loop. I'm not using the userform for this, just inputting the variables directly into F2 and F3 on my Macro sheet.

Also, if the Truck variable doesn't exist in the Pick Verify sheet at all I get an "Object variable or with block variable not set" error.

New code:

Sub DeleteTransaction()

Dim RngFound As Range
Dim PSheet As Worksheet, MSheet As Worksheet
Dim StrTruck As String
Dim StrStop As String
Dim strFirst As String


Set PSheet = Worksheets("Pick Input")
Set MSheet = Worksheets("Macro")
StrTruck = MSheet.Range("F2").Value
StrStop = MSheet.Range("F3").Value


    Set RngFound = PSheet.Columns("J:J").Find(StrTruck, Cells(Rows.Count, "J:J"), xlValues, xlWhole, xlPrevious)
    If Not RngFound Is Nothing And RngFound.Offset(0, 1) = StrStop Then


    strFirst = RngFound.Address
    
        Do Until RngFound.Address <> strFirst
            RngFound.Offset(1, 0).EntireRow.Delete
            RngFound.EntireRow.Delete
            Set RngFound = PSheet.Columns("J:J").Find(StrTruck, Cells(Rows.Count, "J:J"), xlValues, xlWhole, xlPrevious)
        Loop
               
    MsgBox ("Transaction Deleted")
               
    Else: MsgBox ("Transaction Not Found")
               
    End If
        
    Set RngFound = Nothing
    
End Sub

 

[LCTrucido]

I believe the blank rows are what is causing it to not find all of the matches but I'm not sure how to force it to continue searching through them.

 

[Fluff]

How about

Sub DeleteTransaction()

    Dim PSheet As Worksheet, MSheet As Worksheet
    Dim StrTruck As String
    Dim StrStop As String
    Dim Cl As Range
    
    
    Set PSheet = Worksheets("Pick Input")
    Set MSheet = Worksheets("Macro")
    StrTruck = MSheet.Range("F2").Value
    StrStop = MSheet.Range("F3").Value

    With PSheet
        For Each Cl In .Range("J2", .Range("J" & Rows.Count).End(xlUp))
            If Cl.Value = StrTruck And Cl.Offset(, 1).Value = StrStop Then
             Cl.Offset(, 1).Resize(2).Value = "#N/A"
             End If
        Next Cl
        .Columns(9).SpecialCells(xlConstants, xlErrors).EntireRow.Delete
    End With
               
    
End Sub

 

[LCTrucido]

How about

Sub DeleteTransaction()

    Dim PSheet As Worksheet, MSheet As Worksheet
    Dim StrTruck As String
    Dim StrStop As String
    Dim Cl As Range
    
    
    Set PSheet = Worksheets("Pick Input")
    Set MSheet = Worksheets("Macro")
    StrTruck = MSheet.Range("F2").Value
    StrStop = MSheet.Range("F3").Value

    With PSheet
        For Each Cl In .Range("J2", .Range("J" & Rows.Count).End(xlUp))
            If Cl.Value = StrTruck And Cl.Offset(, 1).Value = StrStop Then
             Cl.Offset(, 1).Resize(2).Value = "#N/A"
             End If
        Next Cl
        .Columns(9).SpecialCells(xlConstants, xlErrors).EntireRow.Delete
    End With
               
    
End Sub

Hey, thanks for taking the time to help out. I just tried this and it will run until it finds the first match, then throws a type mismatch error. It doesn't make it as far as deleting the rows containing errors.

I tried using an error handler (one at a time) in the following positions but the code then fills column K entirely with #N/A after the first match.

 On Error Resume Next
     Cl.Offset(, 1).Resize(2).Value = "#N/A"
 On Error Resume Next

 

[Fluff]

Apologies, I've missed a - sign

Sub DeleteTransaction()

    Dim PSheet As Worksheet, MSheet As Worksheet
    Dim StrTruck As String
    Dim StrStop As String
    Dim Cl As Range
    
    
    Set PSheet = Worksheets("Pick Input")
    Set MSheet = Worksheets("Macro")
    StrTruck = MSheet.Range("F2").Value
    StrStop = MSheet.Range("F3").Value

    With PSheet
        For Each Cl In .Range("J2", .Range("J" & Rows.Count).End(xlUp))
            If Cl.Value = StrTruck And Cl.Offset(, 1).Value = StrStop Then
             Cl.Offset(, [COLOR=#ff0000]-[/COLOR]1).Resize(2).Value = "#N/A"
             End If
        Next Cl
        .Columns(9).SpecialCells(xlConstants, xlErrors).EntireRow.Delete
    End With
               
    
End Sub

Also forgot to mention, do you have any formulas in col I, if so I need to now of a blank col I can use.

 

[LCTrucido]

Unreal. You're a super genius, that worked like a charm. I guess I should have caught that from the use of Column(9)

There are no formulas in the Pick Input sheet, it's just a data dump from a piece of software.

 

[LCTrucido]

I added an error handler to accommodate the Not Found message, final code is:

Sub DeleteTransaction()

    Dim PSheet As Worksheet, MSheet As Worksheet
    Dim StrTruck As String
    Dim StrStop As String
    Dim Cl As Range
    
    
    Set PSheet = Worksheets("Pick Input")
    Set MSheet = Worksheets("Macro")
    StrTruck = MSheet.Range("F2").Value
    StrStop = MSheet.Range("F3").Value


    On Error GoTo ErrorHandler


    With PSheet
        For Each Cl In .Range("J2", .Range("J" & Rows.Count).End(xlUp))
            If Cl.Value = StrTruck And Cl.Offset(, 1).Value = StrStop Then
             Cl.Offset(, -1).Resize(2).Value = "#N/A"
             End If
        Next Cl
        .Columns(9).SpecialCells(xlConstants, xlErrors).EntireRow.Delete
    
    MsgBox ("Transaction Deleted")
    
    End With
    
    Exit Sub
    
ErrorHandler:
    MsgBox ("Transaction Not Found")
    
End Sub

 

[Fluff]

Glad to help & thanks for the feedback

 

[LCTrucido]

I also realized that leaving inputs blank would result in problems so one more change:

Sub DeleteTransaction()

    Dim PSheet As Worksheet, MSheet As Worksheet
    Dim StrTruck As String
    Dim StrStop As String
    Dim Cl As Range
    
    
    Set PSheet = Worksheets("Pick Input")
    Set MSheet = Worksheets("Macro")
    StrTruck = MSheet.Range("F2").Value
    StrStop = MSheet.Range("F3").Value
    
    If Not IsNumeric(StrTruck) Or _
        Not IsNumeric(StrStop) Then
            MsgBox ("Please Enter Truck And Stop")
                
    Exit Sub
    
    End If
    
    On Error GoTo ErrorHandler


    With PSheet
        For Each Cl In .Range("J2", .Range("J" & Rows.Count).End(xlUp))
            If Cl.Value = StrTruck And Cl.Offset(, 1).Value = StrStop Then
             Cl.Offset(, -1).Resize(2).Value = "#N/A"
             End If
        Next Cl
        .Columns(9).SpecialCells(xlConstants, xlErrors).EntireRow.Delete
    
    MsgBox ("Transaction Deleted")
    
    End With
    
    Exit Sub
    
ErrorHandler:
    MsgBox ("Transaction Not Found")
    
End Sub