VBA adaptation - Help!

[ElsiE93]

Hi guys,

I'm looking to create a macro to automatically filter out any data from one tab that matches any values in my Mids tab Column C. To do this, I have used a countif function to work out if there is a match or not then filter out the true values. Once done, I use some other VBA code to delete any hidden rows.

I did this manually by recording the macro but when I re-runit it did not do the same thing.
All my data disappears, filters are applied to the headersand Column C (Compass?) has the Header as an option to filter by.
I’m needing this to also be dynamic as the number of rows tobe assessed will vary.
Coding I have is below. Any help you could give me would be greatly appreciated!
Sub Compass_Remove_2()
'
' Compass_Remove_2 Macro
'
'
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Select
ActiveCell.FormulaR1C1 = "Compass?"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Mids!R2C3:R804C3,RC2)>0"
Range("C2").Select
Selection.FillDown
ActiveSheet.Range("$A$1:$Z$106").AutoFilter Field:=3, Criteria1:="FALSE"
End Sub

 

[Mentor82]

Hi guys,

I'm looking to create a macro to automatically filter out any data from one tab that matches any values in my Mids tab Column C. To do this, I have used a countif function to work out if there is a match or not then filter out the true values. Once done, I use some other VBA code to delete any hidden rows.

I did this manually by recording the macro but when I re-runit it did not do the same thing.
All my data disappears, filters are applied to the headersand Column C (Compass?) has the Header as an option to filter by.
I’m needing this to also be dynamic as the number of rows tobe assessed will vary.
Coding I have is below. Any help you could give me would be greatly appreciated!
Sub Compass_Remove_2()
'
' Compass_Remove_2 Macro
'
'
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Select
ActiveCell.FormulaR1C1 = "Compass?"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Mids!R2C3:R804C3,RC2)>0"
Range("C2").Select
Selection.FillDown
ActiveSheet.Range("$A$1:$Z$106").AutoFilter Field:=3, Criteria1:="FALSE"
End Sub

If I understood you correctly you want to filter records in particular column the data which are in the Mids worksheet, is that correct? If, so I'd need to know in which column the data should be picked up from main worksheet in order to check if they exists in Mids sheet?
The header row in both worksherts is 1, right?
Regards,
Sebastian

 

[ElsiE93]

Hi Sebastian,

The Mids worksheet is just my master info sheet. I have another worksheet from which I am removing data if there is a match in the C column of the Mids sheet. The main worksheet has the data to compare in Column B and the result of the countif is in Column C.

Thank you!

 

[Fluff]

How about

Sub Compass_Remove_2()
'
' Compass_Remove_2 Macro
'
'
Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Value = "Compass?"
Range("C2", Range("B" & Rows.Count).End(xlUp).Offset(, 1)).FormulaR1C1 = "=COUNTIF(pcode!R2C3:R804C3,RC2)>0"
With Range("$A$1:$Z$1")
   .AutoFilter Field:=3, Criteria1:="FALSE"
   .Parent.AutoFilter.Range.Offset(1).EntireRow.Delete
   .Parent.AutoFilterMode = False
End With

End Sub

 

[Mentor82]

Hi,
Thank you for explanation. Do you need a macro to filter the records found in Mids and then keep removing thmeem manually or mightn't it be better for you so you have the macro that searches if records exist in Mids and if so deletes such records automatically?
Regards,
Sebastian

 

[ElsiE93]

Hi Sebastian,

Having it done automatically would be amazing!

 

[ElsiE93]

Hi Fluff, thank you for your suggestion. I have given it a go. It doesn't unfilter all my data which is a good start! All values in Column C of my main worksheet return #VALUE !. Do you have any suggestions of how to overcome this? Thanks!

 

[ElsiE93]

Wait, I've figured it out! Thanks Fluff for your help. I tweaked Pcode to Mids, and changed 'False' to 'True' and it reveals just the information I need. Thank you to both of you for your help on solving this issue! :D:D:D

 

[Fluff]

Glad we could help & thanks for the feedback

 

[Mentor82]

Hi Sebastian,

Having it done automatically would be amazing!

Hi,
I'm sorry for my belated answer. Here I've prepared for you the macro that picks the value in colum C in active sheet and searches it sheets MS and removes the record automatically if finds it (it works both for hidden/unhidden records).
What you have to do is paste it in the module and set the following constant values as you wish:

Const ACTSHT_HEADERROW& = 1 'Header row no in the active sheet where the rows are to be deleted
    Const ACTSHT_COLUMN& = 3 'Column no with data to be picked for verification if exists in Mids worksheet - it's a third column in excel sheet which is "C"
    
    Const MAIN_SHTNAME$ = "Mids" 'The main sheet name where algorism will check if the data exists
    Const MAINSHT_HEADERROW& = 1 'Header row no in the main sheet where algorism will check if the data exists
    Const MAINSHT_COLUMN& = 3 'The search column no in main worksheet

Here's the whole code to pase (2 subs). Hope you'll find that useful. I wish you Happy New Year 2019! :) : 

Sub RemoveExistingRows()
    Dim i&, j&
    Dim ActiveSht_LastRow&
    Dim MainSht_LastRow&
    Dim Act_WS As Worksheet
    Dim Main_WS As Worksheet
    Dim record_found As Boolean
    Dim counter&
    
    Const ACTSHT_HEADERROW& = 1 'Header row no in the active sheet where the rows are to be deleted
    Const ACTSHT_COLUMN& = 3 'Column no with data to be picked for verification if exists in Mids worksheet - it's a third column in excel sheet which is "C"
    
    Const MAIN_SHTNAME$ = "Mids" 'The main sheet name where algorism will check if the data exists
    Const MAINSHT_HEADERROW& = 1 'Header row no in the main sheet where algorism will check if the data exists
    Const MAINSHT_COLUMN& = 3 'The search column no in main worksheet
    
    On Error GoTo ErrorHandler
    
    counter = 0
    
    Set Act_WS = ActiveSheet
    Set Main_WS = Worksheets(MAIN_SHTNAME)
    If Act_WS.Name = Main_WS.Name Then
        MsgBox "It's not allowed to run the procedure on the active sheet: " & MAIN_SHTNAME & ". It should be run on another, where the data is to be deleted.", vbExclamation, "Improper action"
    Else
        Application.ScreenUpdating = False
        
        'Remove filter in active sheet
        RemoveFilter Ws:=Act_WS
        'Get last rows in both sheets
        ActiveSht_LastRow = Act_WS.Cells(Rows.Count, ACTSHT_COLUMN).End(xlUp).Row
        MainSht_LastRow = Main_WS.Cells(Rows.Count, MAINSHT_COLUMN).End(xlUp).Row
    
        If ActiveSht_LastRow <= ACTSHT_HEADERROW Or MainSht_LastRow <= MAINSHT_HEADERROW Then
            MsgBox "There's no data available to proceed!", vbInformation, "InfoLog"
        Else
            'Ask user if to search and remove existing data
            If MsgBox("Do you want to search and remove data from sheet: " & Act_WS.Name & " if exists in sheet: " & MAIN_SHTNAME, vbQuestion + vbYesNo, "InfoLog") = vbYes Then
                For i = ActiveSht_LastRow To ACTSHT_HEADERROW + 1 Step -1
                    record_found = False
                    For j = MAINSHT_HEADERROW + 1 To MainSht_LastRow
                        If Act_WS.Cells(i, ACTSHT_COLUMN) = Main_WS.Cells(j, MAINSHT_COLUMN) Then
                            record_found = True
                            Exit For
                        End If
                    Next j
                
                    If record_found = True Then
                        Act_WS.Rows(i).Delete
                        counter = counter + 1
                    End If
                Next i
                MsgBox "Done. Number of found and removed records: " & counter, vbInformation, "InfoLog"
            End If
        End If
    End If
    
DataClearance:
    Application.ScreenUpdating = True
    Set Act_WS = Nothing
    Set Main_WS = Nothing
    
    Exit Sub
    
ErrorHandler:
    MsgBox "Unexpected error occured." & vbNewLine & _
           "Error No.: " & Err.Number & vbNewLine & _
           "Error Description: " & Err.Description, vbCritical, "Error Info"
    Resume DataClearance
End Sub
Sub RemoveFilter(Ws As Worksheet)
    On Error Resume Next
    Ws.AutoFilter.ShowAllData
End Sub