Delete specific rows from selection in for each loop

Question

I'm trying to delete rows which don't contain new words.

What I do:

Select multiple rows manually
Run macro, which checks each row and adds new words from it to a dictionary. If there are no new words - the row should be deleted.

The problem: When macro deletes a row, it should go to the next row with "Next cell", but it skips one.

I need your help because I have no Idea how to make it work in VBA (newbie here). How to prevent that skipping and process each row in selection?

Demo data:

A B 
A B C
C B 
A C
A B F

My Result:

A B 
A B C
A C
A B F

Should be:

A B 
A B C
A B F

Code:

Sub clean_keys()

' unique words
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

For Each cell In Selection

    Dim strArray() As String
    Dim intCount As Integer

    strArray = Split(cell.Value, " ")

    Dim intWords As Integer 
    intWords = 0

    For intCount = LBound(strArray) To UBound(strArray)

        If dict.Exists(Trim(strArray(intCount))) Then
            dict(Trim(strArray(intCount))) = dict(Trim(strArray(intCount))) + 1
        Else
            dict.Add Key:=Trim(strArray(intCount)), Item:=1
            intWords = intWords + 1
        End If

    Next

    If intWords = 0 Then
        cell.EntireRow.Delete
    End If

Next cell
End Sub

score 2 · Accepted Answer · 2017-06-10 18:02:18Z

2

Always run from the bottom to the top when deleting rows or you risk skipping rows (as you have noticed).

'don't dim inside a loop
Dim r As Long
Dim strArray As Variant
Dim intCount As Integer
Dim intWords As Integer

With Selection
    For r = .Rows.Count To 1 Step -1

        strArray = Split(Selection.Cells(r).Value & " ", " ")
        intWords = 0

        For intCount = LBound(strArray) To UBound(strArray) - 1
            If dict.Exists(Trim(strArray(intCount))) Then
                dict(Trim(strArray(intCount))) = dict(Trim(strArray(intCount))) + 1
            Else
                dict.Add Key:=Trim(strArray(intCount)), Item:=1
                intWords = intWords + 1
            End If
        Next intCount

        If intWords = 0 Then
            .Cells(r).EntireRow.Delete
        End If

    Next r
End With

edited Jun 10, 2017 at 18:02

answered Jun 10, 2017 at 17:14

user4039065

Sign up to request clarification or add additional context in comments.

2 Comments

tonyAndr Over a year ago

Good solution, but I have a problem with it: on line For r = selection... it stops with error:invalid procedure call or argument

user4039065 Over a year ago

My apologies. I don't usually work with Selection and I was over-thinking the process.

Collectives™ on Stack Overflow

Delete specific rows from selection in for each loop

1 Answer 1

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related