Duplicate merging & Checklist Macro

[Peter Murray]

Dear any Excel genius who can help me!

I have recently inherrited a rather bulky Excel spreasheet at work which holds all the email address's for our Events E-Flier List. Now although I'm not too shabby when it come to the basics of Excel I am utterly useless when it comes to Macro's (I just can't get my head around the language).

The spreadsheet looks something like this (there are more options columns along the top)

<TABLE style="WIDTH: 287pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=378 border=0 x:str><COLGROUP><COL style="WIDTH: 100pt; mso-width-source: userset; mso-width-alt: 4864" width=133><COL style="WIDTH: 17pt; mso-width-source: userset; mso-width-alt: 804" span=2 width=22><COL style="WIDTH: 41pt; mso-width-source: userset; mso-width-alt: 1974" width=54><COL style="WIDTH: 16pt; mso-width-source: userset; mso-width-alt: 768" span=7 width=21><TBODY><TR style="HEIGHT: 89.25pt" height=119><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 100pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 89.25pt; BACKGROUND-COLOR: transparent" width=133 height=119>EMAIL ADDRESS</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 17pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: #99cc00" width=22>On "Do Not Send" List?</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 17pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=22 x:str=""></TD><TD class=xl27 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 41pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: #99cc00" width=54>Text Only / Images</TD><TD class=xl28 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 16pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: black" width=21>All</TD><TD class=xl28 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 16pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: black" width=21>Comedy</TD><TD class=xl28 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 16pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: black" width=21>Family</TD><TD class=xl29 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 16pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: #ffcc00" width=21>Ice</TD><TD class=xl29 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 16pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: #ffcc00" width=21>Kids</TD><TD class=xl29 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 16pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: #ffcc00" width=21>Panto</TD><TD class=xl28 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 16pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: black" width=21>Music</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl30 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>BlahBlah@Hotmail.com</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>1</TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl32 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl30 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>Johnsmith@gmail.com</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>1</TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>1</TD><TD class=xl32 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17></TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD><TD class=xl31 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent"></TD></TR></TBODY></TABLE>

What happens is anyone who want to receive our eflier submits their email and states what kind of events they are interested in, i.e. all events, comedy and music etc, and we make a 1 in the column they want so that we can sort the database later on and target the particular audiences.

Now the issue we have is that when we take the email addresses from our online ticket source we will add them to the database. However we can only take information from one show at a time and say for instance John Smith has been to see a stand up comedy gig and a music gig in the past month he will be on both lists. What we need to do is filter out all duplicates on the list but instead of deleting them we need to merge them together as the data they have requested may vary from each show, i.e they may be recently down as wanting to get info for comedy from the stand up gig they went to but they may already be in the system to receive information on music from a previous gig. We don't want to lose them off either list but rather need to have them merge together so one entry is on both lists.

In addition to this on an additional worksheet we also keep a record of any email address's to not send information to, i.e. any email addresses which have become inactive or one's where the customer does not wish to recieve efliers for one reason or another. Each time we add to the database the macro needs to cross reference that database to see if they are on the list. If they are then it removes their details from the main eflier list. We are a local theatre and only interested in sending our eflier to people who want it, we're not in the business of spamming people.

We do currently have two macro's which are suppose to do this but for some reason they don't appear to have ever worked.

Now I call upon any genius who can create macro's with ease to help. Do you have any simple coding which I can create a macro to do both these jobs, either separately or in one big macro? I have no clue where to start. The Current Macro Coding we have is below but it could just be Chinese for all i can read.

I do imagine its a nightmare to trawl through this code, i've been doing it for days and still make no sense out of it. But if anyone can help me with this problem i will be forever in your debt. Any solutions would be really appreciated.

Duplicate removing macro

Public Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first value will be deleted.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Long, eventCols As Long, lastActiveCell As Long
Dim V As Variant
Dim Rng As Range, rCell As Range
Dim rowVal As Integer, colVal As Integer

On Error GoTo EndMacro
'turning off screen updating greatly speeds up the macro
Application.ScreenUpdating = False

'*****************************
'* this block of code checks for duplicate values and marks them with a "Yes"
'* the following code should merge and delete all duplicates before the user
'* can see the "Yes"
'*

' Select the column in which we are checking for duplicates
Range("A3").Select
Dim emailLoop As Long
emailLoop = 2
Do
If Cells(emailLoop, 1).Value = Cells(emailLoop - 1, 1).Value Then
Cells(emailLoop, 1).Offset(0, 1).Value = "Yes"
Else
Cells(emailLoop, 1).Offset(0, 1).Value = "No"
End If
emailLoop = emailLoop + 1
Loop Until Cells(emailLoop, 1) = ""

'*
'*****************************

Range("B2").Select
Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
ActiveSheet.Columns(ActiveCell.Column))

For R = 0 To Rng.Rows.Count Step 1

'all of the duplicate emails will have a Yes in column B, search for each "Yes"
V = "Yes"
Set rCell = Cells.Find(What:=V, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)

'if no "Yes"s can be found then either there were none to start with, or they have
' already been removed
If rCell Is Nothing Then
MsgBox ("Duplicates removed / none found.")
End If

'This search is in twice as the previous one is used to stop errors when no "Yes"s
' can be found
Cells.Find(What:=V, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True) _
.Activate

rowVal = ActiveCell.Row
colVal = ActiveCell.Column

'if the row number of the next "Yes" is lower than the previous one, that means the
' code has looped, so go to the end of the macro
If rowVal < lastActiveCell Then GoTo EndMacro

'loop through the duplicate columns and merge the categories
'**** REMEMBER to add 1 to this value for each new event type added ****
For eventCols = 4 To 35
If (Cells(rowVal, colVal).Offset(-1, eventCols).Value = "") And _
(Cells(rowVal, colVal).Offset(0, eventCols).Value = "1") Then
Cells(rowVal, colVal).Offset(-1, eventCols).Value = "1"
'************* There is a problem with this part of the code, when you have the time
'************* look through this and try to sort it out
End If
Next eventCols

'delete only the duplicate Row
'** Cells(rowVal, colVal).EntireRow.Delete

'make lastActiveCell the row number of the last "Yes" that was found
lastActiveCell = rowVal
Next R

EndMacro:
'restart the screen updating so the user can see formulas reflecting any
' changes they make to the worksheet
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
Call DeleteDuplicateRows
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
End Sub

Adding onto the do not send list

Sub checkDoNotSendList()
Range("C2").Select
Application.ScreenUpdating = False
Do Until ActiveCell.Value = "1"
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-2],'DO NOT SEND'!R1C1:R978C1,1,FALSE)=TRUE)," & Chr(34) & Chr(34) & ",VLOOKUP(RC[-2],'DO NOT SEND'!R1C1:R709C1,1,FALSE))"
'"=VLOOKUP(RC[-2],'DO NOT SEND'!R1C1:R978C1,1,FALSE)"
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
End Sub