Split number from an alpha numeric invoice reference and highlight duplicate

[anish.ms]

Dear All,

I have attached a sample data wherein I could separate the number from an alpha numeric invoice reference and also highlight the duplicate numbers. But I need to highlight the duplicate numbers only if the vendor name is also matching .
Request your help in the code to highlight duplicate numbers if both the vendor name (column D) and invoice number (column K) matches.
Any help on the above could help my work and would be greatly appreciated.


Thanks


Option Explicit


Sub FindDuplicateInvoice()
Dim lastRow As Long
Dim sh1 As Worksheet
Dim myCell As Range, myRange As Range


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Set sh1 = Sheets("chk_double_inv")
lastRow = sh1.UsedRange.Rows.Count
Set myRange = Range("F2:F" & lastRow)

For Each myCell In myRange
If Not IsEmpty(myCell) Then
Cells(myCell.Row, "K") = Strip(myCell, True)
End If
Next myCell

Set myRange = Range("K2:K" & lastRow)
For Each myCell In myRange
If Not IsEmpty(myCell) Then
If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then
myCell.Interior.ColorIndex = 3
myCell.Font.ColorIndex = 2
End If
End If
Next myCell
End Sub


Public Function Strip(ByVal x As String, LeaveNums As Boolean) As Variant
Dim y As String, z As String, n As Long
For n = 1 To Len(x)
y = Mid(x, n, 1)
If LeaveNums = False Then
If y Like "[A-Za-z ]" Then z = z & y 'False keeps Letters and spaces only
Else
If y Like "[0-9. ]" Then z = z & y 'True keeps Numbers and decimal points
End If
Next n
Strip = Trim(z)
End Function

[Paul_Hossler]

Maybe ...



Sub FindDuplicateInvoice()
Dim lastRow As Long
Dim sh1 As Worksheet
Dim myCell As Range, myRange As Range
Dim aryInvoiceVendor() As String
Dim s As String
Dim n As Long, i As Long, j As Long


Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set sh1 = Sheets("chk_double_inv")
lastRow = sh1.UsedRange.Rows.Count
Set myRange = Range("F2:F" & lastRow)

ReDim aryInvoiceVendor(2 To lastRow)

With sh1.Range("K2:K" & lastRow)
.ClearContents
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 1
End With


For Each myCell In myRange
If Not IsEmpty(myCell) Then
sh1.Cells(myCell.Row, "K") = Strip(myCell, True)
s = sh1.Cells(myCell.Row, "D") & Chr(0) & sh1.Cells(myCell.Row, "K")
aryInvoiceVendor(myCell.Row) = s
End If
Next myCell

For i = LBound(aryInvoiceVendor) To UBound(aryInvoiceVendor)
If Not IsEmpty(aryInvoiceVendor(i)) Then
s = sh1.Cells(i, "D") & Chr(0) & sh1.Cells(i, "K")
n = 0

For j = LBound(aryInvoiceVendor) To UBound(aryInvoiceVendor)
If aryInvoiceVendor(j) = s Then n = n + 1
Next j

If n > 1 Then
For j = LBound(aryInvoiceVendor) To UBound(aryInvoiceVendor)
If aryInvoiceVendor(j) = s Then
sh1.Cells(j, "K").Interior.ColorIndex = 3
sh1.Cells(j, "K").Font.ColorIndex = 2
End If
Next j
End If
End If
Next i


Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

[anish.ms]

Thanks Paul_Hossler (http://www.vbaexpress.com/forum/member.php?9803-Paul_Hossler)!

Exactly this is what I was looking for