VBA macro to Find and Highlight duplicate/match

[Alphix]

Hi I am stuck on how to accomplish the following:
I need a VBA macro to Find and Highlight duplicate/match within a range of part numbers and to find an highlight a match within 3 columns.
See image.

Your help is greatly appreciated.

 

[Saurabhj]

Hi, can you please share the data using XL2BB.

It would help to copy the data in my excel.

Thanks,
Saurabh

 

[Alphix]

Hi Saurabh, below is the data.

Check for Dup.xlsx
	A	B	C	D	E
1
2	Check For Duplicate		Check 1	Check 2	Check 3
3	A03B-0824-K202		MAKINO Z-AXIS WIPER #Y000Z2010049, OLD M	Y000Z2010049	MAKINO
4	A03B-0824-K203		SEALING DISK CDER32040M ADB	CDER32040M	ERICKSON KENNAMETAL
5	A06B-1468-B133#0R21		SEAL DISK CDER32100M ADB	CDER32100M	KENNAMETAL
6	A06B-2227-B200		15IP TORX TORQUE DRIVER,300 TX15 3,0Nm	5027935001 A60L-0001-0183#75AS	WERA, MOTION # 12702X00045
7	A06B-2247-B100		SPRING-GUIDE-ATC ARM - 16M60A702 MA01	16M60A702	MAKINO 11
8	A06B-2247-B400		SPRING Z291A3404015 SPINDLE COOLANT	Z291A3404015	MAKINO 11
9	A06B-6200-C601		PALLET STOP #M0302700	M0302700	MAKINO
10	A06B-6200-C603		SCREW CLAMP STCM35-T15 KENNAMETAL/ORDER	STCM35-T15	KENNAMETAL
11	A06B-6200-C604		SCREW MS1157PKG KENNAMETAL 10 PCS=1PACK	MS1157 (1) = PKG OF 10 PRICE $28.79 PAK	KENNAMETAL ORDER 1 = 1 PKG OF 10 SCREWS
12	A06B-6200-C607		SCREW M6 MS-965	MS965 A03B-0824-K202	KENNAMETAL
13	A06B-6200-C609		SCREW M6 #MS966 KENNAMETAL ADB	MS966	KENNAMETAL
14	A06B-6200-C610		INSERT SCREW MS-1160 ADB	MS-1160	KENNAMETAL
15	A06B-6200-H026		LOCK SCREW M6 F.P.S.S.S. ADB	M6X6FPSSS	ADAPTIVE TECH
16	A06B-6220-H015#H600		BAR CODE SCANNER COMPLETE (MFG. P/N K	K370-SR1211100US SEND OUT FOR REPAIR	SYMBOL-OBSOLETE-NEED SUGGEST REPLACMENT
17	A06B-6240-H208		12X1/2X18T HIGH SPEED HACKSAW BLD 218HE	218HE ITEM# 03099983	AMERICAN S MOTION
18	A06B-6240-H209		792541-7 MAKITA SAW BLADES (PK/5)	792541-7	MAKITA A98L00310028
19	A20B-2004-0691
20	A20B-2101-0840		Compare Column A for duplicate in D,E,F Columns
21	A20B-2102-0672		First Compare as an exact match	Highlight Match
22	A20B-2102-0681		Second compare without hyphens	Highlight Match
23	A60L-0001-0183#100AS		Third compare without spaces	Highlight Match
24	A60L-0001-0183#75AS
25	A60L-0001-0290#LM32C
26	A90L-0001-0575#A
27	A90L-0001-0576
28	A90L-0001-0577
29	A90L-0001-0580#B
30	A90L-0001-0581
31	A98L-0031-0028
Sheet1

 

[Alphix]

The idea is to place the material number to be checked in column "A" and then have a macro button to run the check.
The code needs to search through column C,D, and E for duplicates of the following conditions to see an exact match,
to see if numbers match without Hyphens or see if number matches without spaces. Then highlight the matches.

Thank you so much!

 

[Saurabhj]

Hi Thanks for sharing data and description.
Can you please highlight one data for each case as an example. It will help to create macro.
cases:
1. Exact Match
2. Match without Hyphens
3. Match without space

 

[Saurabhj]

Hi, See attached image. I didn't find any example for case#3

 

[Alphix]

Can you provide a macro that will do case 1 & 2?

That will greatly be appreciated.

 

[Saurabhj]

Hi Alphix,

Use below code:

Sub highlightCell()
    Dim lastRow As Integer, rowno As Integer
    Dim exactSubstr As String, noHyphen As String
    
    lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    With Sheets("Sheet1")
        For rowno = 3 To lastRow
            For colno = 3 To 5
                totalRows = .Cells(Rows.Count, colno).End(xlUp).Row
                For checkRow = 3 To totalRows
                    exactSubstr = .Cells(rowno, 1)
                    noHyphen = WorksheetFunction.Substitute(.Cells(rowno, 1), "-", "")
                    If InStr(1, .Cells(checkRow, colno), exactSubstr) > 0 Then
                        .Cells(checkRow, colno).Interior.Color = vbGreen
                    End If
                    If InStr(1, .Cells(checkRow, colno), noHyphen) > 0 Then
                        .Cells(checkRow, colno).Interior.Color = vbBlue
                    End If
                Next
            Next
        Next
    End With
End Sub

 

[Alphix]

Thank you Saurabh, this works fine. Perfect solution.
I appreciate you all in the community.

 

[Saurabhj]

My Pleasure and thanks a lot for the feedback.