Link to home
Start Free TrialLog in
Avatar of gisvpn
gisvpnFlag for United States of America

asked on

Remove Rows from Worksheet - VBA Macro

Hello,

I have the attached spreadsheet with two worksheets. One worksheet (called data) just lists rows of email addresses and the other worksheet (called emails) also lists email addresses. What I would like to be able to do is create a VBA macro which will look at the email addresses on the emails tab (this list will change regularly) and if the email address does not exist in a row on the data tab in either column Email 1 (F) or Email 2 (H) then delete the row - the effect being it will leave only rows where the email (from the emails tab) appears in either column F or H! If possible I don't want the check to be case sensitive - I was thinking of using something like UCASE in the macro or something?

Could someone help me with this macro - I have started but failed at getting it to work.

Regards,

GISVPN
Example-WS.xlsx
SOLUTION
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of [ fanpages ]
[ fanpages ]

Here is an alternate approach, that creates an AutoFilter on column [ B ] of the [Emails] worksheet, adds a formula to each row (matching the corresponding value of column [A] to the two applicable columns )[F] & [H]) within the [Data] worksheet), filters column [ B ] of [Emails] on the outcome of the formula (FALSE; i.e. not found), & then deletes every matching row within the Filtered result, before finally removing the AutoFilter, & clearing the contents of column [ B ]...

Public Sub Q_28713409b()

  Dim blnErr_Ignore                                     As Boolean
  Dim objRange                                          As Range
  Dim objWorksheet_Emails                               As Worksheet
  
  On Error GoTo Err_Q_28713409b

  blnErr_Ignore = False

  Set objWorksheet_Emails = ThisWorkbook.Worksheets("Emails")
  
  objWorksheet_Emails.Activate
  
  Application.ScreenUpdating = False
  
  If (ActiveSheet.FilterMode) Then
     ActiveSheet.AutoFilterMode = False
  End If ' If (ActiveSheet.FilterMode) Then
  
  Columns(2).ClearContents
  
  Set objRange = Range([A2], Cells(Rows.Count, "A").End(xlUp))
  
  If objRange.Row > 1& Then
     objRange.Offset(0&, 1).Formula = "=IFERROR(OR(MATCH(A2,Data!F:F,0),MATCH(A2,Data!H:H,0)),FALSE)"
     [B1] = "Filter"
     
     [B1].AutoFilter
     ActiveSheet.Columns(2).AutoFilter Field:=2, Criteria1:="=FALSE"
     
     blnErr_Ignore = True
     Set objRange = Nothing
     Set objRange = Range([A2], Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
     blnErr_Ignore = False
     
     If Not (objRange Is Nothing) Then
        objRange.EntireRow.Delete
     End If ' If Not (objRange Is Nothing) Then
  End If ' If objRange.Row > 1& Then
  
Exit_Q_28713409b:

  On Error Resume Next

  If Not (objWorksheet_Emails Is Nothing) Then
     objWorksheet_Emails.Activate
     
     If (ActiveSheet.FilterMode) Then
        ActiveSheet.AutoFilterMode = False
     End If ' If (ActiveSheet.FilterMode) Then
     
     Columns(2).ClearContents
     
     Set objWorksheet_Emails = Nothing
  End If ' If Not (objWorksheet_Emails Is Nothing) Then
  
  Set objRange = Nothing
  
  Application.ScreenUpdating = True

  Exit Sub
  
Err_Q_28713409b:

  lngErr_Number = Err.Number
  strErr_Description = Err.Description

  On Error Resume Next

  If (blnErr_Ignore) Then
     On Error GoTo Err_Q_28713409b
     Resume Next
  End If ' If (blnErr_Ignore) Then
 
  Application.ScreenUpdating = True
  
  Beep
  MsgBox "Error #" & CStr(lngErr_Number) & _
         vbCrLf & vbLf & _
         strErr_Description, _
         vbExclamation Or vbOKOnly, _
         ThisWorkbook.Name

  Resume Exit_Q_28713409b
  
End Sub

Open in new window


This routine & the one from my previous comment are both within the attached workbook.
Q_28713409b.xlsm
Avatar of gisvpn

ASKER

Hi Fanpages - thanks for the post; the example worksheet you posted does not seem to work?

Martin - I will try your code, thanks too for the post.
"Hi Fanpages - thanks for the post; the example worksheet you posted does not seem to work?"

What outcome are you seeing, or what messages are displayed?  The worksheets within both workbooks are the same as you provided.

(I presume you are aware how to execute the code once the workbook is open but, if not, please let me know & I will advise you accordingly).

Regardless of this, the code is posted (for both routines) for you to try in your own workbook.
Avatar of gisvpn

ASKER

Sure I must be running it incorrectly; could you please confirm ?
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Sure I must be running it incorrectly; could you please confirm ?

Trying to advise you what you may be doing incorrectly, when I do not know what you are doing is going to prove difficult! :)

Have you manually run the code, or did you expect it to happen when you opened the workbook?

Please open the second workbook I posted (in Comment ID: 40974505); "Q_28713409b.xlsm".

This contains the code for the two different approaches I proposed, & also your original worksheets, [Data], & [Emails].  [Emails] is selected when the workbook is opened.

Click to [Enabled Editing], if prompted...

User generated image
Click to [Enable Content], if prompted...

User generated image
Hold down the (left) [ALT] key, keep it pressed down & press the [F8] key, on your keyboard.

Release [F8], then release [ALT].

That is, use [ALT]+[F8] to open the "Macro" window...

User generated image
Select either routine ("Q_28713409" as shown in the above image, or "Q_28713409b"), then click the [Run] button.

Nothing will happen initially, as both e-mail addresses you entered originally exist in (both) column [F] &/or column [H] of the [Data] worksheet.

However, if you then add a third entry (on the fourth row) of [Emails], for example...

User generated image
...or edit the existing two entries, or add as many new entries to column [A] as desired.

When you repeat the [ALT]+[F8] key combination, select "Q_28713409" or "Q_28713409b" from the list of "Macros", then click the [Run] button again, any e-mails address that do not exist within either column [F] or column [H] of the [Data] worksheet will be removed (as the entire row from [Emails] will be deleted, as you requested).

Hmmm... running "Q_28713409b" now I noticed that it may also remove the heading in row #1 (as the explicit text "Emails" does not exist in either of the designated columns of the [Data] worksheet)!  Whoops.  Obviously too tired at just past midnight when I posted the second approach.

"Q_28713409" works as intended though.  I can adjust "Q_28713409b" if you wish.
I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015, Experts-Exchange Top Expert Visual Basic Classic 2012 to 2014
Avatar of gisvpn

ASKER

Thanks for the help on this one - sktneer - solution spot on thanks.

Fanpages - thanks for the guidance above, I think I worked out why I had not thought it had worked. I believe you have it the wrong way around. You provided a solution whereby it would remove from the emails tab any email address that does not appear on the data tab - however I needed the other way around where any email address on the data tab not appearing on the email tab should be removed from the data tab!

Sorry it was probably the way in which I described it, but the solution provided by sktneer was the one I was needing help with!

Thanks again all!

Regards,
GISVPN
OK, thanks.

If you had mentioned that before closing the thread, I would have been happy to amend what I provided.

Still, we both learned something regarding approaching questions in the future, I hope.
You're welcome gisvpn! Glad I could help. :)