Search for proper column and find duplicates - macro amendment needed [VBA] - vba

Question

I have a VBA Macro for excel to find duplicates. It works but it is specified to a certain column. I would like to search through column headers which are in the 1st row and find the header called "Email" (the best would be "Email*" as sometimes this header contains some other words after the "Email" word). I think this script doesn't adjust to the number of rows and it is limited to 65536 values. I would prefer to let this script adjust to the number of values in the column. I have a similar VBA macro which does the perfect job. I thought I would be able to use this macro as an example and amend the one which I am currently working on...however I failed. Could anyone help me to do the proper amendments to the first code?
VBA MACRO WHICH I WOULD LIKE TO AMEND:
Option Explicit
Sub DeleteDups()
Dim x As Long
Dim LastRow As Long
Sheets("test").Activate
LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).Interior.Color = RGB(255, 48, 48)
End If
Next x
End Sub
VBA MACRO WHICH WORKS FINE AND I WANTED TO USE AS AN EXAMPLE:
Function getAllColNum(ByVal rowNum As Long, ByVal searchString As Variant) As Object
Dim allColNum As Object
Dim i As Long
Dim j As Long
Dim width As Long
Set allColNum = CreateObject("Scripting.Dictionary")
colNum = 1
With ActiveSheet
width = .Cells(rowNum, .Columns.Count).End(xlToLeft).Column
For i = 1 To width
If InStr(UCase(Trim(.Cells(rowNum, i).Value)), UCase(Trim(searchString))) > 0 Then
allColNum.Add i, ""
End If '
Next i
End With
Set getAllColNum = allColNum
End Function
Sub GOOD_WORKS_No_Dots_at_End_of_Emails()
Dim strSearch As String
strSearch = "Email"
Dim colNum As Variant
Dim allColNum As Object
Sheets("Data").Activate
Dim LR As Long, i As Long
Set allColNum = getAllColNum(1, searchString)
For Each colNum In allColNum
LR = Cells(Rows.Count, colNum).End(xlUp).Row
For i = 1 To LR
With Range(Cells(i, colNum), Cells(i, colNum))
If Right(.Value, 1) = "." Then .Value = Left(.Value, Len(.Value) - 1)
End With
Next i
Next colNum
Sheets("Automation").Activate
MsgBox "No Dots at the end of email addresses - Done!"
End Sub
MY WORK SO FAR
Function getAllColNum(ByVal rowNum As Long, ByVal searchString As Variant) As Object
Dim allColNum As Object
Dim i As Long
Dim j As Long
Dim width As Long
Set allColNum = CreateObject("Scripting.Dictionary")
colNum = 1
With ActiveSheet
width = .Cells(rowNum, .Columns.Count).End(xlToLeft).Column
For i = 1 To width
If UCase(Trim(.Cells(rowNum, i).Value)) Like UCase(Trim(searchString)) Then
allColNum.Add i, ""
End If '
Next i
End With
Set getAllColNum = allColNum
End Function
Sub testing_testing()
Dim strSearch As String
strSearch = "Email"
Dim colNum As Variant
Dim allColNum As Object
Sheets("Data").Activate
Dim LR As Long, i As Long
Set allColNum = getAllColNum(1, searchString)
For Each colNum In allColNum
LR = Cells(Rows.Count, colNum).End(xlUp).Row
For i = 1 To LR
With Range(Cells(i, colNum), Cells(i, colNum))
If Application.WorksheetFunction.CountIf(Range("R1:A" & x), Range("R" & x).Text) > 1 Then
Range("A" & x).Interior.Color = RGB(255, 48, 48)
End With
End If
Next i
Next colNum
Sheets("Automation").Activate
MsgBox "Finiding duplicates - Done!"
End Sub
Seems to be more complicated and as I mentioned I have limited knowledge of VBA. However, I found a different script which might be easier to amend.
This macro finds the email address column and marks the whole column
Option Explicit
Sub GOOD_WORKS_Mark_Email_Duplicates()
Dim x As Long
Dim LastRow As Long
Sheets("test").Activate
LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).Interior.Color = RGB(255, 48, 48)
End If
Next x
MsgBox "Email duplicates has been marked - red cells. Check if there are any red cells in the Email column"
End Sub
This one finds duplicates using countif function (which is good to me. The only problem is that I have this macro as a button, where the range is specified
Sub Highlight_Duplicates(Values As Range)
Dim Cell
For Each Cell In Values
If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then
Cell.Interior.ColorIndex = 6
End If
Next Cell
End Sub
Then the action button:
Private Sub CommandButton1_Click()
Highlight_Duplicates (Sheets("Test").Range("C2:C92"))
End Sub
It is fine for me to run 1st macro and then the 2nd. However, I don't know how to get rid of Range in the action button. Any ideas?

Answer 1

In your getAllColNum function, change this:
If InStr(UCase(Trim(.Cells(rowNum, i).Value)), _
UCase(Trim(searchString))) > 0 Then
to this:
If UCase(Trim(.Cells(rowNum, i).Value)) Like UCase(Trim(searchString)) Then
and that will allow you to pass a wildcard header like "email" and get all matching columns.