bloubul
Member
Hi All
I have the following macro, but I need help to change it. Currently it only look at two numbers. I ask please will some change it for me to look between 2 and 5 numbers...
Here are the macro:::
Sub SearchForAPair_02()
Dim myNum As String
myNum = InputBox("search for...", "select a pair of numbers like 16-61", "16-61")
If myNum = "" Then Exit Sub
Dim v As Variant
v = Split(myNum, "-")
Const FirstR As Long = 3 '<< source data, first row
Const FirstC As String = "A" '<< first column
Const LastC As String = "G" '<< last column
Const TargetC As String = "Q" '<<< first Target Column
Dim ws As Worksheet
Set ws = ActiveSheet
Dim r As Long, c As Long, i As Long, t As Long, N As Long
r = ws.Cells(Rows.Count, FirstC).End(xlUp).Row
N = ws.UsedRange.Rows.Count
c = ws.Range(ws.Cells(FirstR, FirstC), ws.Cells(FirstR, LastC)).Columns.Count
ws.Range(FirstC & ":" & LastC).Interior.ColorIndex = xlNone
ws.Cells(1, TargetC).Resize(N, c + 1).Clear
If UBound(v) <> 1 Then MsgBox "wrong, select 2 numbers": Exit Sub
Application.ScreenUpdating = False
Dim r1 As Range, r2 As Range
t = 2
For i = FirstR To r
Set r1 = ws.Cells(i, FirstC).Resize(, c).Find(What:=v(0), LookIn:=xlValues, LookAt:=xlWhole)
Set r2 = ws.Cells(i, FirstC).Resize(, c).Find(What:=v(1), LookIn:=xlValues, LookAt:=xlWhole)
If Not r1 Is Nothing And Not r2 Is Nothing Then
r1.Interior.Color = RGB(255, 255, 0): r2.Interior.Color = RGB(255, 255, 0)
ws.Range(ws.Cells(i - 1, FirstC), ws.Cells(i, LastC)).Copy ws.Cells(t, TargetC)
ws.Cells(t, TargetC).Offset(, c) = "row " & i - 1: ws.Cells(t + 1, TargetC).Offset(, c) = "row " & i
t = t + 2
End If
Next
r = ws.Cells(Rows.Count, TargetC).End(xlUp).Row
If r = 1 Then MsgBox "nothing found": Exit Sub
ws.Range(ws.Cells(1, FirstC), ws.Cells(1, LastC)).Copy ws.Cells(1, TargetC)
ws.Cells(1, TargetC).Resize(r, c + 1).EntireColumn.AutoFit
ws.Range(FirstC & ":" & LastC).Interior.ColorIndex = xlNone
Application.ScreenUpdating = True
End Sub
I thank you.
BlouBul
I have the following macro, but I need help to change it. Currently it only look at two numbers. I ask please will some change it for me to look between 2 and 5 numbers...
Here are the macro:::
Sub SearchForAPair_02()
Dim myNum As String
myNum = InputBox("search for...", "select a pair of numbers like 16-61", "16-61")
If myNum = "" Then Exit Sub
Dim v As Variant
v = Split(myNum, "-")
Const FirstR As Long = 3 '<< source data, first row
Const FirstC As String = "A" '<< first column
Const LastC As String = "G" '<< last column
Const TargetC As String = "Q" '<<< first Target Column
Dim ws As Worksheet
Set ws = ActiveSheet
Dim r As Long, c As Long, i As Long, t As Long, N As Long
r = ws.Cells(Rows.Count, FirstC).End(xlUp).Row
N = ws.UsedRange.Rows.Count
c = ws.Range(ws.Cells(FirstR, FirstC), ws.Cells(FirstR, LastC)).Columns.Count
ws.Range(FirstC & ":" & LastC).Interior.ColorIndex = xlNone
ws.Cells(1, TargetC).Resize(N, c + 1).Clear
If UBound(v) <> 1 Then MsgBox "wrong, select 2 numbers": Exit Sub
Application.ScreenUpdating = False
Dim r1 As Range, r2 As Range
t = 2
For i = FirstR To r
Set r1 = ws.Cells(i, FirstC).Resize(, c).Find(What:=v(0), LookIn:=xlValues, LookAt:=xlWhole)
Set r2 = ws.Cells(i, FirstC).Resize(, c).Find(What:=v(1), LookIn:=xlValues, LookAt:=xlWhole)
If Not r1 Is Nothing And Not r2 Is Nothing Then
r1.Interior.Color = RGB(255, 255, 0): r2.Interior.Color = RGB(255, 255, 0)
ws.Range(ws.Cells(i - 1, FirstC), ws.Cells(i, LastC)).Copy ws.Cells(t, TargetC)
ws.Cells(t, TargetC).Offset(, c) = "row " & i - 1: ws.Cells(t + 1, TargetC).Offset(, c) = "row " & i
t = t + 2
End If
Next
r = ws.Cells(Rows.Count, TargetC).End(xlUp).Row
If r = 1 Then MsgBox "nothing found": Exit Sub
ws.Range(ws.Cells(1, FirstC), ws.Cells(1, LastC)).Copy ws.Cells(1, TargetC)
ws.Cells(1, TargetC).Resize(r, c + 1).EntireColumn.AutoFit
ws.Range(FirstC & ":" & LastC).Interior.ColorIndex = xlNone
Application.ScreenUpdating = True
End Sub
I thank you.
BlouBul