Search a 3 digit number and its variants

  • Thread starter Thread starter PeteD
  • Start date Start date
P

PeteD

I am trying to search a 3 digit number and its variations in a file. If my
file starts with example 763 I want to go thru the rest of the file to see if
there is 367, 673, 736, 376, and 637. Then goes to the next number in the
file to search this 3 digit number and find its variations. And so until end
of file. I would like to put the number(s) found and it variants in another
column. I am a nubiw and no nothing about excel programming but do not know
where to look. Thanks
 
I made some assumption about your request.

1) the data is in a file
2) You wanted each number to appear only once in the results. I wasn't sure
if there were duplicate numbers in the list.
3) The workbook were the macro is located is empty and contains sheet1 and
sheet2.


The code opens a dialog box to open the file and places the data into sheet
1. Then the code searches through sheet 1 and puts the results into sheet2.


Sub GetVariants()

Dim NumArray(0 To 5)

Set DataSht = Sheets("Sheet1")
Set Results = Sheets("sheet2")

fileToOpen = Application _
.GetOpenFilename(Title:="Get file")
If fileToOpen = False Then
MsgBox ("Cannot Open file - Exiting Macro")
Exit Sub
End If

'read data file and put into worksheet
With DataSht
With ActiveSheet.QueryTables.Add( _
Connection:="TEXT;" & fileToOpen, _
Destination:=.Range("A1"))

.Name = "Threedigits"
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.Refresh BackgroundQuery:=False
End With

ResultRow = 1
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow

If .Range("B" & RowCount) = "" Then
Num = .Range("A" & RowCount)
'place number on New sheet
Results.Range("A" & ResultRow) = Num

Set SearchRange = _
.Range("A" & RowCount & ":A" & LastRow)

'create 5 permutations of the num
NumArray(1) = Val(Mid(Num, 1, 1) & _
Mid(Num, 3, 1) & Mid(Num, 2, 1))
NumArray(2) = Val(Mid(Num, 2, 1) & _
Mid(Num, 1, 1) & Mid(Num, 3, 1))
NumArray(3) = Val(Mid(Num, 2, 1) & _
Mid(Num, 3, 1) & Mid(Num, 1, 1))
NumArray(4) = Val(Mid(Num, 3, 1) & _
Mid(Num, 1, 1) & Mid(Num, 2, 1))
NumArray(5) = Val(Mid(Num, 3, 1) & _
Mid(Num, 2, 1) & Mid(Num, 1, 1))

ColCount = 2
For Each SearchNum In NumArray
Set c = SearchRange.Find(what:=SearchNum, _
LookIn:=xlValues, lookat:=xlWhole)
'if number is found
If Not c Is Nothing Then
If SearchNum <> Num Then
Results.Cells(ResultRow, ColCount) = SearchNum
ColCount = ColCount + 1
End If
'put an x in column b so we don't
'search number already found
.Range("B" & RowCount) = "X"
End If
Next SearchNum
ResultRow = ResultRow + 1
End If
RowCount = RowCount + 1
Next RowCount

End With

End Sub
 
Back
Top