Microsoft Excel for Microsoft 365 MSO (Version 2402 Build 16.0.17328.20068) 64-bit
Posts
28,399
Re: duplicate FINDER
Option Explicit
Sub find_Dupplicates()
Dim a, i As Long, j As Integer, nPos As Integer, nx As String, ny As String
Application.ScreenUpdating = False
a = Range("A1:H" & Cells(Rows.Count, "C").End(xlUp).Row)
For i = 1 To UBound(a, 1)
nPos = InStr(1, a(i, 3), "on")
If nPos > 0 Then
nx = Mid(a(i, 3), nPos - 7, 6)
For j = i + 1 To UBound(a, 1)
If a(j, 8) <> "READ" Then
nPos = InStr(1, a(j, 3), "on")
If nPos > 0 Then
ny = Mid(a(j, 3), nPos - 7, 6)
If ny = nx Then
a(i - 1, 8) = "READ": a(j - 1, 8) = "READ"
End If
End If
End If
Next j
End If
Next i
[A1].Resize(UBound(a, 1), 8) = a
Application.ScreenUpdating = True
End Sub
Last edited by JohnTopley; 08-12-2023 at 06:41 AM.
If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED.
UDF
Use in cell like
H4:
=DupFinder(C5,$C$5:$C$27)
then fildown
Function DupFinder(r As Range, rng As Range) As String
Dim x, t As String, c As Range
x = Split(r, "fh")
If UBound(x) < 1 Then Exit Function
t = Right$(Split(x(1))(0), 6)
If Not t Like "######" Then Exit Function
For Each c In rng
x = Split(c, "fh")
If UBound(x) > 0 Then
If (r.Address <> c.Address) * (t = Right$(Split(x(1))(0), 6)) Then
DupFinder = "Read": Exit For
End If
End If
Next
End Function
To differentiate I would not just put READ in each line.
Sub jec()
Dim ar, sp, sp2, st, j As Long, jj As Long
ar = Cells(1).CurrentRegion.Resize(, 8)
For j = 1 To UBound(ar)
sp = Split(ar(j, 3), "fh")
If UBound(sp) > 0 Then
st = Right(Split(sp(1))(0), 6)
For jj = j + 1 To UBound(ar)
sp2 = Split(ar(jj, 3), "fh")
If UBound(sp2) > 0 Then
If st = Right(Split(sp2(1))(0), 6) Then
ar(j - 1, 8) = st
ar(jj - 1, 8) = st
Exit For
End If
End If
Next
End If
Next
Columns(8).NumberFormat = "000000"
Cells(1).CurrentRegion.Resize(, 8) = ar
End Sub
According to the attachment a formula VBA demonstration for starters :
PHP Code:
Sub Demo1() Application.ScreenUpdating = False With ActiveSheet.UsedRange.Columns(9) .Formula = "=IF(LEFT(C1,5)=""BANK "",IFERROR(MID(C2,FIND("" on "",C2)-6,6),""""),"""")" .Item(0) = Evaluate(Replace("IF(#>"""",IF(COUNTIF(#,#)>1,""READ"",""""),"""")", "#", .Address)) .Clear End With Application.ScreenUpdating = True End Sub
► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄
JEC read is okay , since you are finding a very rare case , 1 out of 99 situation , but that 1 is money thus important what slip of came in as duplicate
Bookmarks