Code Adjustment for copying lookup results needed

[kelly mort]

I am looking for a fix to this code so that it will look for the InputBox entry from column C and E instead of looking for them from just column C.

Thanks in advance

Sub AnotherLoop_1063452()
Dim r As Range, rng As Range, rng1 As Range, b As Boolean
Dim arr As Variant
Application.ScreenUpdating = False

Set rng = Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
b = False
arr = Split(Application.InputBox("Please enter two 2-digit numbers separated by a comma."), ",")
If UBound(arr) <> 1 Then
    MsgBox "Your entry is invalid. Please try again."
    Exit Sub
End If

For Each r In rng
    If InStr(r.Value, arr(0)) > 0 And InStr(r.Value, arr(1)) > 0 Then
        b = True
        On Error GoTo nxt
        Set rng1 = Application.Union(rng1, r)
    End If
Next r
If b = True Then
    rng1.EntireRow.Copy
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Paste
Else
    MsgBox "No match found."
End If

Exit Sub
nxt:
    Set rng1 = r
    On Error GoTo 0
    Resume Next
End Sub

 

[kelly mort]

That is one string from column C and another from column E.
Sorry I forgot to clarify that

 

[Fluff]

Try

Sub AnotherLoop_1063452()
Dim r As Range, rng As Range, rng1 As Range, b As Boolean
Dim arr As Variant
Application.ScreenUpdating = False

Set rng = Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
arr = Split(Application.InputBox("Please enter two 2-digit numbers separated by a comma."), ",")
If UBound(arr) <> 1 Then
    MsgBox "Your entry is invalid. Please try again."
    Exit Sub
End If

For Each r In rng
    If InStr(r.Value, arr(0)) > 0 And InStr(r.Offset(, 2).Value, arr(1)) > 0 Then
        If rng1 Is Nothing Then Set rng1 = r Else Set rng1 = Application.Union(rng1, r)
    End If
Next r
If Not rng1 Is Nothing Then
    rng1.EntireRow.Copy
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Paste
Else
    MsgBox "No match found."
End If

End Sub

 

[kelly mort]

Great!!!

Thanks @Fluff

 

[Fluff]

You're welcome