Thread: Find Identical 4 numbers Straight Or Permuted In a Range

Hi,

Just to ask anyone down here could help with VB to create a VB so that i could put a list in column A and compare it with column C and i get result in column D if the numbers in column A and column C match in either straight or permuted way.

Thank you.Attached a sample of what i need.

Thank A Lot

Hi vanaj

Could you use a User Defined Function

Option Explicit
Function Contains(xpat$, ind$) As String
    Dim objRegExp As Object
    Dim indx$
    Dim mypattern$
    indx = ind$
    Set objRegExp = CreateObject("VBScript.RegExp")
    With objRegExp
        .IgnoreCase = True
        .Global = True
        mypattern = "([" & xpat & "])"
        .Pattern = mypattern
        ind = .Replace(ind, String("$1", " "))
        .Pattern = "([0-9])"
        If .test(ind) Then
            Contains = "No match"
        Else
            Contains = xpat & " contained in " & indx
        End If
    End With
End Function

vanaj,


Detach/open workbook Find4 arrays a c d InStr - vanaj - EF803173 - SDG16.xls and run macro Find4.



If you want to run the macro on another workbook:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Option Base 1
Sub Find4()
' stanleydgromjr, 11/26/2011
' http://www.excelforum.com/excel-new-users/803173-find-identical-4-numbers-straight-or-permuted-in-a-data-range-part-2-a.html
Dim a(), c(), d()
Dim r As Long, rr As Long, f As Long, n As Long
Columns(4).ClearContents
a = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
c = Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)
ReDim d(1 To UBound(c), 1 To 1)
For r = LBound(c) To UBound(c)
  n = 0
  For rr = LBound(a) To UBound(a)
    f = 0
    If InStr(a(rr, 1), Mid(c(r, 1), 1, 1)) > 0 Then f = f + 1
    If InStr(a(rr, 1), Mid(c(r, 1), 2, 1)) > 0 Then f = f + 1
    If InStr(a(rr, 1), Mid(c(r, 1), 3, 1)) > 0 Then f = f + 1
    If InStr(a(rr, 1), Mid(c(r, 1), 4, 1)) > 0 Then f = f + 1
    If f = 4 Then
      n = n + 1
      If n = 1 Then
        d(r, 1) = c(r, 1) & " is contained in: " & a(rr, 1)
      Else
        d(r, 1) = d(r, 1) & "," & a(rr, 1)
      End If
    End If
  Next rr
Next r
Range("D1").Resize(UBound(d)) = d
Columns(4).AutoFit
End Sub

Then run the Find4 macro.

Hi stanleydgromjr
if column 5 Trying to work out why its a match
2587 7984 =7984 is contained in: 7894
was vanaj intial data incorrect?

pike,

It would appear that his original result in cell D4 was not correct (not aligned):
4578 is contained in: 7894 (4578 is NOT contained in 7894)

@stanleydgromjr

;-)Thank you very much.

hi vanaj

if you would like a sub then

Option Explicit
Sub Contains()
    Dim objRegExp As Object
    Dim indx As String
    Dim mypattern$
    Dim xCell As Range
    For Each xCell In Range("A1", Cells(Rows.Count, 1).End(xlUp))
        indx = xCell.Offset(, 2).Value
        Set objRegExp = CreateObject("VBScript.RegExp")
        With objRegExp
            .IgnoreCase = True
            .Global = True
            mypattern = "([" & xCell.Value & "])"
            .Pattern = mypattern
            indx = Trim(.Replace(xCell.Offset(, 2).Value, String("$1", " ")))
            .Pattern = "([0-9])"
            If .Test(indx) Or IsEmpty(xCell.Offset(, 2).Value) Then
                xCell.Offset(, 3).Value = "No match"
            Else
                xCell.Offset(, 3).Value = xCell.Value & " contained in " & xCell.Offset(, 2).Value
            End If
        End With
    Next
End Sub

and please dont use the quotes to reply

Don't quote whole posts -- it's just clutter.

If you are responding to a post out of sequence, limit quoted content to a few relevant lines that makes clear to whom and what you are responding.

vanaj,

You are very welcome.

Glad I could help.

Thanks for the feedback.

Come back anytime.