Still struggling with VBA to delete rows

[jmazorra]

Hello folks:

I posted earlier last week on this code, I have done some work on it but it is still not working as intended. I want to delete all rows in byEmployee and byPosition sheets if the row name is not listed in range A1:A in Sheet1.

Right now, the loop deletes all rows on byEmployee and by Position except for row 1 (which is my header name). I can't get it to work properly.

Any ideas where I am going wrong here?

Sub delColumnNames()
 
Dim ColName As String
Dim LastRow As Long
Dim LastCol As Long
Dim RowRange As Range
Dim RowWS As Worksheet
Dim lngLr As Long
Dim WS As Worksheet
Dim i As Long
Dim temp
 
    'List of rows (to keep)
    Set RowWS = Sheets("Sheet1")
    LastRow = RowWS.Cells(Rows.Count, 2).End(xlUp).Row
    Set RowRange = RowWS.Range("A2:A" & LastRow)
   
   
    For Each WS In Sheets(Array("byEmployee", "byPosition"))
       
        With WS
           
            LastCol = .Cells(Rows.Count, 1).End(xlUp).Row
            'Step through rows and delete those not in RowRange list or Blank
            For i = LastCol To 1 Step -1
                ColName = .Cells(2, i).Value
                If ColName = "" Then
                    'Row is blank - delete it
                    .Cells(2, LastCol).Rows.EntireRow.Delete
                Else
                    On Error Resume Next
                    temp = WorksheetFunction.Match(ColName, RowRange, 0)
                    On Error GoTo 0
                    'Row not found in row range list - delete it
                    If IsNumeric(temp) Then
                        .Cells(1, i).EntireRow.Delete
                    End If
                End If
            Next i 'Next column
       
        End With
   
    Next WS
   
   
End Sub

 

[patel45]

LastCol = .Cells(Rows.Count, 1).End(xlUp).Row

is not last column but last row

 

[jmazorra]

Thanks, it did not work.

 

[rallcorn]

You've got quite a bit of confusion and conflicting info in your code.

ASSUMING you really do want do delete ROWS (not columns) and assuming the item you're trying to match is in Col A on all 3 sheets, try this:

Sub delColumnNames()
 
Dim ColName As String
Dim LastRow As Long
Dim RowRange As Range
Dim RowWS As Worksheet
Dim lngLr As Long
Dim WS As Worksheet
Dim i As Long
Dim temp As Long
 
    'List of rows (to keep)
    Set RowWS = Sheets("Sheet1")
       
    'Finds # of last row in Col A of RowWS
    LastRow = RowWS.Range("A" & Rows.Count).End(xlUp).Row
    
    Set RowRange = RowWS.Range("A2:A" & LastRow)
   
    For Each WS In Sheets(Array("byEmployee", "byPosition"))
       
        With WS
           WS.Activate
           'Finds # of last row in Col A of worksheet in loop
            lngLr = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
                        
            'Step through rows and delete those
            'where Col A name is not found in RowRange list
            'or Col a name is blank
'Stepping to row TWO since you say row 1 is header
            For i = lngLr To 2 Step -1
                
                'Get current row's Col A Value
                ColName = Range("A" & i).Value
                
                If ColName = "" Then
                    'Row is blank - delete it
                    Range("A" & i).EntireRow.Delete
                Else
                    On Error Resume Next
                    
                    'Counts if WS current row's Col A value
                    'is found in RowRange
                    temp = WorksheetFunction.CountIf(RowRange, ColName)
                    On Error GoTo 0
                    'Name not found - delete row
                    '(if not found count will be ZERO)
                    If temp > 0 Then
'Skips "delete" if count is >0                        
GoTo Skip
                        Else
                        Range("A" & i).EntireRow.Delete
                    End If
                End If
Skip:
            Next i
        End With
    Next WS
   
MsgBox "Done!"
   
End Sub

 

[Gigi_]

it doesn't work if the strangers are on a1
so:

Sub delColumnNames()
 
Dim ColName As String
Dim LastRow As Long
Dim RowRange As Range
Dim RowWS As Worksheet
Dim lngLr As Long
Dim WS As Worksheet
Dim i As Long
Dim temp As Long
 
    'List of rows (to keep)
    Set RowWS = Sheets("Sheet1")
       
    'Finds # of last row in Col A of RowWS
    LastRow = RowWS.Range("A" & Rows.Count).End(xlUp).Row
    
    Set RowRange = RowWS.Range("A2:A" & LastRow)
   
    For Each WS In Sheets(Array("byEmployee", "byPosition"))
       
        With WS
           WS.Activate
           'Finds # of last row in Col A of worksheet in loop
            lngLr = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
                        
            'Step through rows and delete those
            'where Col A name is not found in RowRange list
            'or Col a name is blank
'Stepping to row TWO since you say row 1 is header
            For i = lngLr To 1 Step -1 '''''''''''''''''''here
                
                'Get current row's Col A Value
                ColName = Range("A" & i).Value
                
                If ColName = "" Then
                    'Row is blank - delete it
                    Range("A" & i).EntireRow.Delete
                Else
                    On Error Resume Next
                    
                    'Counts if WS current row's Col A value
                    'is found in RowRange
                    temp = WorksheetFunction.CountIf(RowRange, ColName)
                    On Error GoTo 0
                    'Name not found - delete row
                    '(if not found count will be ZERO)
                    If temp > 0 Then
'Skips "delete" if count is >0
GoTo Skip
                        Else
                        Range("A" & i).EntireRow.Delete
                    End If
                End If
Skip:
            Next i
        End With
    Next WS
   
MsgBox "Well done!"
   
End Sub

tanks to rallcorn

 

[rallcorn]

Gigi, not sure what is meant by this:

it doesn't work if the strangers are on a1

Row 1 is header row on all sheets, so:
the RowRange is defined as A2:A & LastRow
the loop of each sheet goes from lngLR (last row) to row 2

 

[Gigi_]

you're right!!
but i saw the example file....and byEmployee byPosition have no header!!!
i repeat....GREAT WORK AND THANKS TO rallcorn

 

[rallcorn]

but i saw the example file....and byEmployee byPosition have no header!!!

Then, you are correct in changing the code to

For i = lngLr To 1 Step -1

and you might also want to delete the comment

'Stepping to row TWO since you say row 1 is header

so it will make sense to anyone viewing the code in your file at a later date.

Glad you got it going and happy to help!

 

[jmazorra]

Thank you folks. I had been working on this for a few days with no avail.

 

[rallcorn]

Not sure where Gigi fits into the picture, here . . . but you're both welcome!