CODEWITHSUNDEEP
vbaexcel
Fraukje
Fraukje

Reputation: 683

Delete all but one row based on two column values in VBA

I am new to VBA and want to remove rows from an Excel file. I want to remove a row that has a Status 'Completed', but only if there is at least one more row remaining for a CustomerName. In other words, if there is only one more row remaining for a certain CustomerName, it should not be deleted, even though it might have Status 'Completed'.

I figured out how to remove rows if they have Status = 'Completed':

Sub RemoveAlmostAllCompletedRows()
Dim i As Long

i = 1

Do While i <= ThisWorkbook.ActiveSheet.Range("A1").CurrentRegion.Rows.Count

If InStr(1, ThisWorkbook.ActiveSheet.Cells(i, 18).Text, "Completed", vbTextCompare) > 0 Then
    ThisWorkbook.ActiveSheet.Cells(i, 1).EntireRow.Delete
Else
    i = i + 1
End If

Loop

End Sub

This removes all rows that have 'Completed' in column 18 (Status column). Now I am really stuck finding a way to prevent a row with Status = Completed, if that would delete the last remaining row for a CustomerName.

Any ideas or tips to get me going? Your help is much appreciated!

Upvotes: 0

Views: 160

Answers (2)

Scott Holtzman
Scott Holtzman

Reputation: 27249

Place the below line inside the first IF block as another IF block before deleting the row.

If Application.WorksheetFunction.Countif(ThisWorkbook.ActiveSheet.Cells(i,10).EntireColumn),ThisWorkbook.ActiveSheet.Cells(i,10).Value) > 1 Then

This will count the customer names and only call delete line if there is more than 1. I made assumption customer name is in column 10. Change as needed.

Upvotes: 1

simpLE MAn
simpLE MAn

Reputation: 1622

You could use the WorksheetFunction.CountIf. Considering that the column A:A is the one containing the customer names and worksheet Sheet1 is the sheet you're working in:

Sub RemoveAlmostAllCompletedRows()

    'You should always define precisely your worksheet
    Dim WS As Worksheet
    Set WS = ThisWorkbook.Worksheets("Sheet1")

    Dim i As Long
    i = 1

    Do While i <= WS.Range("A1").CurrentRegion.Rows.Count

        If (InStr(1, WS.Cells(i, 18).Text, "Completed", vbTextCompare) > 0) Then
            If (Excel.Application.WorksheetFunction.CountIf(WS.Range("A:A"), _
                WS.Range("A" & i).Value2)) > 1 Then

                WS.Cells(i, 1).EntireRow.Delete

            End If
        Else
            i = i + 1
        End If

    Loop

End Sub

Upvotes: 1

Related Questions