Search for 3 digit number and its rumble combination

[tjc0ol]

Hello excel forum guys,

I need help on this one.

I have a 3 digit numbers in each cells in sheet1 with range from A2 to L1000.

What it does:

1. Will prompt the user to enter 3 digit numbers to be searched in the Sheet1
2. After that, it will find all 3 digit numbers in worksheet1
3. If search found; it will copy the result to Sheet2 (In my case I use offset result)

What I wanted is a small modification in my code(below) to:

• If user enters "123" in the inputbox, it will be stored in a string like in my code below, I used string Searcher
• And create all combination of the numbers entered on the inputbox;
  • Example 1: If user enters "123" in the inputbox; it will create its 5 combination numbers i.e. 132, 213, 231, 312 & 321
  • Example 2: If user enters "456" in the inputbox; it will create its 5 combination numbers i.e. 465, 546, 564, 645 & 654
• And it will search Sheet1 for all 3 digit numbers in a cell that is equal to what has user entered in the inputbox a while ago i.e. (123 and its 5 combination numbers i.e. 132, 213, 231, 312 & 321)
• And proceed to rest of the program flow in the code i.e. copy results in Sheet2

Basically, I wanted to search for all 3-digit numbers with its combination or rumble numbers or (the correct word is permutation) in my records in sheet1 and copy desired offset results in sheet2.

note: That the user always enters 3-digit numbers in the inputbox.

Maybe by doing this is using regular expression or for each or loop. Any help will be appreciated. Thanks in advance guys. -Tj

Here's my code below:

Option Explicit
Public xxx As String
Dim CurrentColumn
Dim CurrentRow

'Find a value in sheet1 and copy the result's offset in sheet2
' Cross Patern
Sub CopyPhraseCells()

    Dim rSearch As Range
    Dim rFound As Range
    Dim sStopCell As String, T As String
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim Searcher$, Finder$
    Dim i As Long
        
    'Get the string to search for!
Searcher = InputBox("Enter what to search for, below:" & vbLf & vbLf & _
"", _
Space(2) & "Find All", _
"")
If Len(Searcher) <= 2 Then Exit Sub

    'change the worksheet names to your needs
    Set wsSource = Worksheets("Sheet1")
    Set wsDestination = Worksheets("Sheet2")
    
    'Set Range
    Set rSearch = wsSource.Columns("A:L")
    
    xxx = Searcher

    Set rFound = rSearch.Find( _
        What:=xxx, _
        After:=Range("L1000").End(xlUp), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        matchbyte:=False)
    
    If rFound Is Nothing Then
        MsgBox """" & Searcher & """" & Space(3) & "Was not found!", _
vbCritical + vbOKOnly, _
Space(3) & "Not Found!"
        Exit Sub
    End If
    
    sStopCell = rFound.Address
    Do
        'Left of #
        rFound.Offset(0, -1).Copy wsDestination.Range("B1000").End(xlUp).Offset(1, 0)
        'Right of #
        rFound.Offset(0, 1).Copy wsDestination.Range("B1000").End(xlUp).Offset(1, 0)
        'Up of #
        rFound.Offset(-1, 0).Copy wsDestination.Range("D1000").End(xlUp).Offset(1, 0)
        'Down of #
        rFound.Offset(1, 0).Copy wsDestination.Range("D1000").End(xlUp).Offset(1, 0)
        
        Set rFound = rSearch.FindNext(rFound)
    Loop Until rFound.Address = sStopCell
    
End Sub