Help with this code

T

thedeadzeds

Active Member
Joined
Aug 16, 2011
Messages
451
Office Version
  1. 365
Platform
  1. Windows
Guys,

Please can someone have a look at the below code. It essentially looks at 12 different tables and removes anything that is not "1st Attempt Made" in column D. Its doesn't seem to work all the time and sometimes leaves 'New Calls', '2nd attempt made; etc in some of the tables.

Sorry if this seems a long way of writing the code but its the only way i could figure it out.

Thanks in advance.

Code: 
Sub Keep_first_attempts()    
    'DIM
    Dim lastRow As Long  'BA Polk Audi Serv & MOT N Calls
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow2 As Long 'BA Kerr Audi Serv & MOT N Calls
    lastRow2 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow3 As Long 'CA Polk Audi Serv & MOT N Calls
    lastRow3 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow4 As Long 'CA Kerr Audi Serv & MOT N Calls
    lastRow4 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow5 As Long 'BAA Polk Audi Serv & MOT N Call
    lastRow5 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow6 As Long 'BAA Kerr Audi Serv & MOT N Call
    lastRow6 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow7 As Long 'VAG Polk Audi Serv & MOT N Call
    lastRow7 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow8 As Long 'VAG Kerr Audi Serv & MOT N Call
    lastRow8 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow9 As Long 'BA Campaign New Calls
    lastRow9 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow10 As Long 'CA Campaign New Calls
    lastRow10 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow11 As Long 'BAA Campaign New Calls
    lastRow11 = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRow12 As Long 'VAG Campaign New Calls
    lastRow12 = Cells(Rows.Count, 1).End(xlUp).Row
    
    
    'TABS
    On Error Resume Next
    Sheets("BA Polk Audi Serv & MOT N Calls").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
    On Error Resume Next
    Sheets("BA Kerr Audi Serv & MOT N Calls").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM3").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow2).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
    On Error Resume Next
    Sheets("CA Polk Audi Serv & MOT N Calls").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM6").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow3).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
    On Error Resume Next
    Sheets("CA Kerr Audi Serv & MOT N Calls").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM314").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow4).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
    On Error Resume Next
    Sheets("BAA Polk Audi Serv & MOT N Call").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM16").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow5).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
    On Error Resume Next
    Sheets("BAA Kerr Audi Serv & MOT N Call").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM31417").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow6).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
    On Error Resume Next
    Sheets("VAG Polk Audi Serv & MOT N Call").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM1621").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow7).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
    On Error Resume Next
    Sheets("VAG Kerr Audi Serv & MOT N Call").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM3141722").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow8).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
    On Error Resume Next
    Sheets("BA Campaign New Calls").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM18").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow9).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
    On Error Resume Next
    Sheets("CA Campaign New Calls").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM1819").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow10).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
      On Error Resume Next
    Sheets("BAA Campaign New Calls").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM181920").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow11).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
        On Error Resume Next
    Sheets("VAG Campaign New Calls").Select
    With Range("A1:A1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        ActiveSheet.ListObjects("Audi_New_SANDM18192025").Range.AutoFilter field:=4, _
        Criteria1:=Array("New Calls", "2nd Attempt made", "3rd Attempt Made"), _
        Operator:=xlFilterValues
    Range("A2:P" & lastRow12).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter
    On Error GoTo 0
    End With
    
End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
As you are not qualifying the sheet in your lastRowxx = Cells(Rows.Count, 1).End(xlUp).Row, then all the lastRow values will be the same, and will be the length of the sheet that was active when you ran it.
 
Upvote 0
WEll the easiest way would be to move each of the lines to immediately after you select the sheet, that way the activesheet will be the one you want the length for. As you say, you have gone a long way round - if I get time over the weekend I will try and rewrite it for you. Are there any tabs in the workbook other than the ones you are referencing in the code?
 
Upvote 0
Try this

Only complete the name of the sheets name and their respective table name in arrays


Code: 
Sub Keep_first_attempts()
    Dim sh As Worksheet, tabs As Variant, tbls As Variant, i As Long
    
    tabs = Array([COLOR=#0000ff]"BA Polk Audi Serv & MOT N Calls", "BA Kerr Audi Serv & MOT N Calls", _[/COLOR]
[COLOR=#0000ff]                 "CA Polk Audi Serv & MOT N Calls", "CA Kerr Audi Serv & MOT N Calls"[/COLOR])
    tbls = Array([COLOR=#008000]"Audi_New_SANDM", "Audi_New_SANDM3", _[/COLOR]
[COLOR=#008000]                 "Audi_New_SANDM6", "Audi_New_SANDM314"[/COLOR])
    
    For i = 0 To UBound(tabs)
        Set sh = Sheets(tabs(i))
        With sh.ListObjects(tbls(i))
            .Range.AutoFilter 4, "<>1st Attempt Made"
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .Range.AutoFilter 4
        End With
    Next
End Sub
 
Upvote 0
In fact, if you only have one table on each sheet; and I think that's the way it is, so we only need the names of the sheets.


Code: 
Sub Keep_first_attempts()
    Dim tabs As Variant, i As Long
    
    tabs = Array("[COLOR=#0000ff]BA Polk Audi Serv & MOT N Calls", "BA Kerr Audi Serv & MOT N Calls", _[/COLOR]
[COLOR=#0000ff]                 "CA Polk Audi Serv & MOT N Calls", "CA Kerr Audi Serv & MOT N Calls"[/COLOR])
    For i = 0 To UBound(tabs)
        With Sheets(tabs(i)).ListObjects(1)
            .Range.AutoFilter 4, "<>1st Attempt Made"
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .Range.AutoFilter 4
        End With
    Next
End Sub
 
Upvote 0
DanteAmor not sure if i thanked you for this but it works great thanks very much
 
Upvote 0
You must log in or register to reply here.

Similar threads

willow1985
  • Solved
Find first blank cell in column A in a Table - Runtime error 91
Replies
4
Views
399
willow1985
willow1985
R
  • Question Question
Can you help with this code please?
Replies
3
Views
375
rlv01
R
willow1985
  • Solved
VBA Compile error - Trying to send an email using VBA/Excel
Replies
6
Views
1K
gorgkhan
G
Guna13
  • Question Question
Help to Optimize Macro Code for Faster Performance
Replies
0
Views
1K
Guna13
Guna13
H
  • Solved
Call to second macro doesn't work if no results in original
Replies
2
Views
494
honkin
H

Forum statistics

Threads
1,224,820
Messages
6,181,155
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top