Excel Macro: Iterating through rows and combined l

Question

I am struggling to find out where the error in my code is.

The situation is the following: I am writing my master thesis and did an experiment where I observed nonverbal behaviour of people. I coded this nonverbal behaviour in a specific program and now as an output I've got an Excel sheet with all the observational data in it. The thing is, a lot of rows contain information that I don't need, so I want to delete them.

My goal: I want to keep only the rows where part of the content of Column C and Column D match (the participant number, starting from 101). I tried to combine two loops together, so that first (the "inner") loop searches for matches through all participant numbers in Column C and D in one row (until participant number 170), if there is no match deletes the row/ if there is a match goes to the next row. The "outter" loop should repeat the steps of the "inner" loop for all the rows that contain data (here until row 2732).

My code so far:

Dim ColumnC As String   
Dim ColumnD As String
Dim ParticipantNumber As String
Dim RowNumber As Integer

Sub SearchAndDeleteRows()
RowNumber = 2
ParticipantNumber = 101
ColumnD = "D" & RowNumber
ColumnC = "C" & RowNumber

Do While RowNumber < 2733

Do While ParticipantNumber < 170

If InStr(Range(ColumnD).Value, ParticipantNumber) = 0 And InStr(Range(ColumnC).Value, ParticipantNumber) > 0 Or InStr(Range(ColumnD).Value, ParticipantNumber) > 0 And InStr(Range(ColumnC).Value, ParticipantNumber) = 0 Then
Rows(RowNumber).Select
    Selection.Delete Shift:=xlUp

Else: GoTo NextParticipant

End If

NextParticipant:
ParticipantNumber = ParticipantNumber + 1

If ParticipantNumber = 170 Then GoTo NextRow
End If

Loop

NextRow:
RowNumber = RowNumber + 1


Loop

End Sub

Note: I know that the GoTo function is evil, but I didn't come up with a way to work around it until now.

I hope I've explained myself clearly.

Thanks in advance for your help!

Cheers, J

Answer 1

Your logic is almost ok, but .find is a much quicker way to get matches. Also, deleting rows while trying to keep track of row numbers is impossible unless you start from the bottom up. Try this instead. It will create a new worksheet and coppy all your good rows to the new sheet. Make sure your active worksheet is the correct one before running it.

Sub copyNOTdelete()
Dim ParticipantNumber As Long, RowNumber As Long
Dim wsMain As Worksheet, WSnew As Worksheet, newRowNumber As Long

Set wsMain = ActiveSheet
Set WSnew = Sheets.Add
wsMain.Activate

RowNumber = 2
newRowNumber = 1
ParticipantNumber = 101

For ParticipantNumber = 101 To 170
    With wsMain.Range("c2:c2733")
        Set c = .Find(CStr(ParticipantNumber), LookIn:=xlValues)
        If Not c Is Nothing Then
            firstaddress = c.Address
            Do
                If wsMain.Range("D" & Right(c.Address, 1)) = ParticipantNumber Then
                    WSnew.Rows(newRowNumber).EntireRow.Value = wsMain.Rows(Right(c.Address, 1)).Value
                    newRowNumber = newRowNumber + 1
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstaddress
        End If
    End With
Next ParticipantNumber
End Sub