vba to find specific combination of chars in one column

gint32 · Sep 11, 2018

Hi all
I have a column that contains free text, I need a way (using vba) to find specific chars in this column the format of the text chars will always be like .. one Alpha and 7 numeric(together).....Examples of this is are D1564567, A1235567, all the way through to Z2356457 and if and when found copy this alpha numeric to he adjacent cell on the right. Not all cells will have this so it needs to e able to skip over records that do not contain, any help appreciated

Peter_SSs · Sep 26, 2018

gint32 said:

.. is there a way to msgbox the whole cell value of the cell as in :

Code:

MsgBox Field:=6, Criteria1:="*" & rng.Cells(2).Value & "*"/Code]

meaning display all of the free text ..[/QUOTE]Now that we have eliminated the "reverse duplicates" (like rows 2 and 5 of Sheet9 from post 46) double-clicking a cell in the results sheet could relate to more than one cell of free text from Workbook 2.

If so, this should display all relevant rows. Replace the code from post 58 with this and give it a try.

[code]Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim rng As Range, c As Range
  Dim txt As String
  
  If Sh.Index = Sheets.Count Then
    If Target.Column <= 2 Then
      Cancel = True
      Set rng = Target.EntireRow.Resize(, 2)
      Application.ScreenUpdating = False
      With Sheets("Workbook 2")
        .AutoFilterMode = False
        With .Range("A1:F" & .Range("A" & .Rows.Count).End(xlUp).Row)
          .AutoFilter Field:=1, Criteria1:=rng.Cells(1).Value, Operator:=xlOr, Criteria2:=rng.Cells(2).Value
          .AutoFilter Field:=6, Criteria1:="*" & rng.Cells(1).Value & "*", Operator:=xlOr, Criteria2:="*" & rng.Cells(2).Value & "*"
          For Each c In .Columns(1).SpecialCells(xlVisible)
            If c.Row > 1 Then txt = txt & vbLf & vbLf & c.Value & ":" & vbLf & c.Offset(, 5).Value
          Next c
        End With
        .AutoFilterMode = False
      End With
      Application.ScreenUpdating = True
      If Len(txt) Then MsgBox txt
    End If
  End If
End Sub

gint32 · Sep 26, 2018

Thanks I’ll give it a try when next in work in 3 days

Also, I have now tried your code on real data and I amgetting data matches that aren’t within Workbook1, could this be affected becauseI replaced the free text with just one Id per record in Column F

Such as

[TABLE="width: 283"]
<tbody>[TR]
[TD="width: 71, bgcolor: transparent"] id's
[/TD]
[TD="width: 64, bgcolor: transparent"] name
[/TD]
[TD="width: 28, bgcolor: transparent"]
[/TD]
[TD="width: 36, bgcolor: transparent"]
[/TD]
[TD="width: 83, bgcolor: transparent"]
[/TD]
[TD="width: 103, bgcolor: transparent"] Free text
[/TD]
[/TR]
[TR]
[TD="width: 71, bgcolor: transparent"]

A

[/TD]
[TD="width: 64, bgcolor: transparent"]

B

[/TD]
[TD="width: 28, bgcolor: transparent"]

C

[/TD]
[TD="width: 36, bgcolor: transparent"]

D

[/TD]
[TD="width: 83, bgcolor: transparent"]

E

[/TD]
[TD="width: 103, bgcolor: transparent"]

F

[/TD]
[/TR]
[TR]
[TD="width: 71, bgcolor: transparent"] B0750106
[/TD]
[TD="width: 64, bgcolor: transparent"] John 0111
[/TD]
[TD="width: 28, bgcolor: transparent"]
[/TD]
[TD="width: 36, bgcolor: transparent"]
[/TD]
[TD="width: 83, bgcolor: transparent"]
[/TD]
[TD="width: 103, bgcolor: transparent"] C0980000
[/TD]
[/TR]
[TR]
[TD="width: 71, bgcolor: transparent"] B0951058
[/TD]
[TD="width: 64, bgcolor: transparent"] John 0112
[/TD]
[TD="width: 28, bgcolor: transparent"]
[/TD]
[TD="width: 36, bgcolor: transparent"]
[/TD]
[TD="width: 83, bgcolor: transparent"]
[/TD]
[TD="width: 103, bgcolor: transparent"] C0980001
[/TD]
[/TR]
[TR]
[TD="width: 71, bgcolor: transparent"] B1049770
[/TD]
[TD="width: 64, bgcolor: transparent"] John 0113
[/TD]
[TD="width: 28, bgcolor: transparent"]
[/TD]
[TD="width: 36, bgcolor: transparent"]
[/TD]
[TD="width: 83, bgcolor: transparent"]
[/TD]
[TD="width: 103, bgcolor: transparent"] C0980002
[/TD]
[/TR]
[TR]
[TD="width: 71, bgcolor: transparent"] B1376047
[/TD]
[TD="width: 64, bgcolor: transparent"] John 0114
[/TD]
[TD="width: 28, bgcolor: transparent"]
[/TD]
[TD="width: 36, bgcolor: transparent"]
[/TD]
[TD="width: 83, bgcolor: transparent"]
[/TD]
[TD="width: 103, bgcolor: transparent"] C0980003
[/TD]
[/TR]
[TR]
[TD="width: 71, bgcolor: transparent"] B1383211
[/TD]
[TD="width: 64, bgcolor: transparent"] John 0115
[/TD]
[TD="width: 28, bgcolor: transparent"]
[/TD]
[TD="width: 36, bgcolor: transparent"]
[/TD]
[TD="width: 83, bgcolor: transparent"]
[/TD]
[TD="width: 103, bgcolor: transparent"] C0980004
[/TD]
[/TR]
[TR]
[TD="width: 71, bgcolor: transparent"] B1525915
[/TD]
[TD="width: 64, bgcolor: transparent"] John 0116
[/TD]
[TD="width: 28, bgcolor: transparent"]
[/TD]
[TD="width: 36, bgcolor: transparent"]
[/TD]
[TD="width: 83, bgcolor: transparent"]
[/TD]
[TD="width: 103, bgcolor: transparent"] C0980005
[/TD]
[/TR]
</tbody>[/TABLE]

Peter_SSs · Sep 26, 2018

gint32 said:
could this be affected becauseI replaced the free text with just one Id per record in Column F

As far as I can see that should not be an issue.

gint32 said:
I have now tried your code on real data and I amgetting data matches that aren’t within Workbook1,..

To try to work out what is happening there you would need to narrow it down to a small set of data for Workbook 1 and Workbook 2 which still demonstrated the issue and provide that sample for me to test with.

gint32 · Sep 26, 2018

Ok. Will do thanks

gint32 · Sep 28, 2018

Peter_SSs said:
provide that sample for me to test with.

Workbook 2 Sample

<colgroup><col style="mso-width-source:userset;mso-width-alt:4864;width:103pt" width="137"> <col style="mso-width-source:userset;mso-width-alt:2275;width:48pt" width="64"> <col style="mso-width-source:userset;mso-width-alt:654;width:14pt" width="18"> <col style="mso-width-source:userset;mso-width-alt:739;width:16pt" width="21"> <col style="mso-width-source:userset;mso-width-alt:796;width:17pt" width="22"> <col style="mso-width-source:userset;mso-width-alt:3811;width:80pt" width="107"> </colgroup><tbody>
[TD="class: xl66, width: 137"]Id's[/TD]
[TD="class: xl63, width: 64"]NAME[/TD]
[TD="class: xl73, width: 18"] [/TD]
[TD="class: xl73, width: 21"] [/TD]
[TD="class: xl73, width: 22"] [/TD]
[TD="class: xl74, width: 107"]Id's[/TD]

[TD="class: xl65"]B0900919[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl81"]B2822968[/TD]

[TD="class: xl65"]B2808593[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]D2238663[/TD]

[TD="class: xl81"]B2822968[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]D2693019[/TD]

[TD="class: xl70"]C1468550[/TD]
[TD="class: xl68"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl78"]D2463636[/TD]

[TD="class: xl71"]C2279306[/TD]
[TD="class: xl72"] [/TD]
[TD="class: xl76"] [/TD]
[TD="class: xl76"] [/TD]
[TD="class: xl76"] [/TD]
[TD="class: xl77"]C1468550[/TD]

[TD="class: xl65"]C2719253[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]D2223336[/TD]

[TD="class: xl65"]C2747459[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]B2577331[/TD]

[TD="class: xl65"]C2754101[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]C2279306[/TD]

[TD="class: xl65"]C2810018[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]C2694251[/TD]

[TD="class: xl65"]E1790689[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]C2268425[/TD]

[TD="class: xl65"]F1542515[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]C2451593[/TD]

[TD="class: xl70"]G2807772[/TD]
[TD="class: xl68"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl78"]C1731809[/TD]

[TD="class: xl70"]G2807772[/TD]
[TD="class: xl68"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl78"]C1731809[/TD]

[TD="class: xl70"]G2807772[/TD]
[TD="class: xl68"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl78"]C1731809[/TD]

[TD="class: xl70"]G2807772[/TD]
[TD="class: xl68"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl69"] [/TD]
[TD="class: xl81"]B2822968[/TD]

[TD="class: xl65"]H1472353[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]C2719253[/TD]

[TD="class: xl65"]I0881855[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]C2747459[/TD]

[TD="class: xl65"]I1775591[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]B1429597[/TD]

[TD="class: xl65"]I2235599[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]C1537967[/TD]

[TD="class: xl65"]I2399885[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]B2686843[/TD]

[TD="class: xl65"]J1911294[/TD]
[TD="class: xl64"] [/TD]

[TD="class: xl75"]C2754101[/TD]

[TD="class: xl65"]J2247210[/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl79"] [/TD]
[TD="class: xl79"] [/TD]
[TD="class: xl79"] [/TD]
[TD="class: xl80"]C2810018
[/TD]

</tbody>

Workbook1

<colgroup><col style="mso-width-source:userset;mso-width-alt:3128;width:66pt" width="88"> <col style="mso-width-source:userset;mso-width-alt:5006;width:106pt" width="141"> </colgroup><tbody>
[TD="class: xl65, width: 88"]Id's[/TD]
[TD="class: xl65, width: 141"]Invites[/TD]

[TD="class: xl66"]B2189962[/TD]
[TD="class: xl67"]Smith 0001[/TD]

[TD="class: xl66"]B2818324[/TD]
[TD="class: xl67"]BROWN 0002[/TD]

[TD="class: xl68"]B2822968[/TD]
[TD="class: xl67"]Tony 007[/TD]

[TD="class: xl69"]C1731809[/TD]
[TD="class: xl67"]Smith 0002[/TD]

[TD="class: xl66"]C2206226[/TD]
[TD="class: xl67"]BROWN 0003[/TD]

[TD="class: xl66"]C2234756[/TD]
[TD="class: xl67"]Smith 0003[/TD]

[TD="class: xl66"]C2247581[/TD]
[TD="class: xl67"]BROWN 0004[/TD]

[TD="class: xl70"]D2463636[/TD]
[TD="class: xl67"]Smith 0004[/TD]

[TD="class: xl66"]E2418529[/TD]
[TD="class: xl67"]BROWN 0005[/TD]

[TD="class: xl66"]E2459614[/TD]
[TD="class: xl67"]Smith 0005[/TD]

[TD="class: xl66"]E2785891[/TD]
[TD="class: xl67"]BROWN 0006[/TD]

[TD="class: xl66"]F2449706[/TD]
[TD="class: xl67"]Smith 0006[/TD]

[TD="class: xl66"]F2759315[/TD]
[TD="class: xl67"]BROWN 0007[/TD]

[TD="class: xl71"]G2807772[/TD]
[TD="class: xl72"]Smith 0007
[/TD]

</tbody>

Results

<colgroup><col style="mso-width-source:userset;mso-width-alt:4152;width:88pt" width="117"> <col style="mso-width-source:userset;mso-width-alt:4551;width:96pt" width="128"> </colgroup><tbody>
[TD="class: xl65, width: 117"]B0900919[/TD]
[TD="class: xl65, width: 128"]B2822968[/TD]

[TD="class: xl65"]C1468550[/TD]
[TD="class: xl65"]D2463636[/TD]

[TD="class: xl65"]G2807772[/TD]
[TD="class: xl65"]C1731809[/TD]

[TD="class: xl65"]G2807772[/TD]
[TD="class: xl65"]B2822968
[/TD]

</tbody>

<colgroup><col style="width:48pt" width="64"> <col style="mso-width-source:userset;mso-width-alt:3783;width:80pt" width="106"> <col style="width:48pt" width="64"> </colgroup><tbody>
[TD="class: xl71, width: 64"]B0900919-
[/TD]
[TD="class: xl69, width: 106"]B2822968[/TD]
[TD="class: xl72, width: 64"]Bad as not invited
[/TD]

[TD="class: xl67"]G2807772-
[/TD]
[TD="class: xl73"]C1731809[/TD]
[TD="class: xl65"]Goodmatch
[/TD]

[TD="class: xl67"]G2807772-
[/TD]
[TD="class: xl66"]B2822968[/TD]
[TD="class: xl65"]Goodmatch
[/TD]

[TD="class: xl74"]C1468550-
[/TD]
[TD="class: xl70"]D2463636[/TD]
[TD="class: xl68"]BadNotOn invites
[/TD]

</tbody>

Peter_SSs · Sep 28, 2018

Thanks, that helps a lot.

I don't remember a stated requirement that both items in a match needed to be checked in Workbook 1, though I certainly could have missed it.
It does make sense, as there is no reason to report a conflict unless both parties are on the invitation list.

Try this modification.

Code:

Sub Find_Matches_v4()
  Dim RX As Object, d As Object, dInv As Object
  Dim a As Variant, m As Variant
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  Set dInv = CreateObject("Scripting.Dictionary")
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  With Sheets("Workbook 1")
    RX.Pattern = "(" & Join(Application.Transpose(.Range("A2", .Range("A2").End(xlDown))), "|") & ")(?=\D|$)"
  End With
  For Each m In Split(Mid(RX.Pattern, 2, Len(RX.Pattern) - 10), "|")
    dInv(m) = Empty
  Next m
  With Sheets("Workbook 2")
    a = Application.Index(.Cells, Evaluate("row(2:" & .Range("A" & .Rows.Count).End(xlUp).Row & ")"), Array(1, 6))
  End With
  For i = 1 To UBound(a)
    For Each m In RX.Execute(a(i, 2))
      If dInv.exists(a(i, 1)) And dInv.exists(CStr(m)) And m <> a(i, 1) Then
        If Not d.exists(a(i, 1) & ";" & m) And Not d.exists(m & ";" & a(i, 1)) Then d(a(i, 1) & ";" & m) = Empty
      End If
    Next m
  Next i
  If d.Count > 0 Then
    Application.ScreenUpdating = False
    Sheets.Add After:=Sheets(Sheets.Count)
    With Sheets(Sheets.Count)
      With .Range("A2").Resize(d.Count)
        .Value = Application.Transpose(d.Keys)
        .TextToColumns DataType:=xlDelimited, Semicolon:=True, Other:=False
      End With
    End With
    Application.ScreenUpdating = True
  Else
    MsgBox "No conflicts found"
  End If
End Sub

gint32 · Sep 28, 2018

Peter_SSs said:
Try this modification.

Many thanks, V4 looks good with the test data, I’ll try it out on Sat at work with real data and get back. You are a champ for sticking with this one ….I can’t thank you enough Pete

Peter_SSs · Sep 29, 2018

Cheers. Look forward to hearing how it goes.

gint32 · Oct 1, 2018

gint32 said:
I’ll try it out on Sat at work with real data and get back

I tried V4 at work and is works just great..Once again ...I can’t thank you enough Pete

any chance you could tell me how it performs this as i look at the v4 vba and am lost!

Peter_SSs · Oct 1, 2018

gint32 said:
I tried V4 at work and is works just great..Once again ...I can’t thank you enough Pete

Good news ...You have.

gint32 said:
.. any chance you could tell me how it performs this as i look at the v4 vba and am lost!

Not that easy to explain unless you are already somewhat familiar with Regular Expressions and the Scripting Dictionary object, but I'll try.

Rich (BB code):

Sub Find_Matches_v4()
  Dim RX As Object, d As Object, dInv As Object
  Dim a As Variant, m As Variant
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  Set dInv = CreateObject("Scripting.Dictionary")
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  
  'Roughly speaking, the items in WB1 are put into a string like this "(A1234567|D5434567|H7860090)".
  'This is the 'Pattern' for the Regular Expression (RX) search a little later.
  'The "|" character acts as an 'OR' operator so the RX would look for A1234567 or D5434567 or H7860090
  With Sheets("Workbook 1")
    RX.Pattern = "(" & Join(Application.Transpose(.Range("A2", .Range("A2").End(xlDown))), "|") & ")(?=\D|$)"
  End With
  
  'But first, each of those values are put into a 'dictionary' (dInv). This is effectively a list of who is invited.
  For Each m In Split(Mid(RX.Pattern, 2, Len(RX.Pattern) - 10), "|")
    dInv(m) = Empty
  Next m
  
  'Load columns A and F (1 & 6) of WB2 into an array ..
  With Sheets("Workbook 2")
    a = Application.Index(.Cells, Evaluate("row(2:" & .Range("A" & .Rows.Count).End(xlUp).Row & ")"), Array(1, 6))
  End With
  
  '.. and work down that array 1 row at a time.
  For i = 1 To UBound(a)
    'Search for any of the Pattern items in the 2nd column, and for each one found ..
    For Each m In RX.Execute(a(i, 2))
      'Check that it and the the value from column A are in the dictionary (invitee list).
      If dInv.exists(a(i, 1)) And dInv.exists(CStr(m)) And m <> a(i, 1) Then
        'If they are, check whether we have already recorded that combination, either way around.
        'If not already recorded, add that combination to another dictionary (d).
        If Not d.exists(a(i, 1) & ";" & m) And Not d.exists(m & ";" & a(i, 1)) Then d(a(i, 1) & ";" & m) = Empty
      End If
    Next m
  Next i
  
  'Write the 'd' dictionary results (if any exist) to a new worksheet, format etc.
  If d.Count > 0 Then
    Application.ScreenUpdating = False
    Sheets.Add After:=Sheets(Sheets.Count)
    With Sheets(Sheets.Count)
      With .Range("A2").Resize(d.Count)
        .Value = Application.Transpose(d.Keys)
        .TextToColumns DataType:=xlDelimited, Semicolon:=True, Other:=False
      End With
    End With
    Application.ScreenUpdating = True
  Else
    MsgBox "No conflicts found"
  End If
End Sub

vba to find specific combination of chars in one column

gint32

Board Regular

Peter_SSs

MrExcel MVP, Moderator

Excel Facts

gint32

Board Regular

Peter_SSs

MrExcel MVP, Moderator

gint32

Board Regular

gint32

Board Regular

Peter_SSs

MrExcel MVP, Moderator

gint32

Board Regular

Peter_SSs

MrExcel MVP, Moderator

gint32

Board Regular

Peter_SSs

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

vba to find specific combination of chars in one column

Board Regular

MrExcel MVP, Moderator

Excel Facts

Board Regular

MrExcel MVP, Moderator

Board Regular

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock