Quantcast
Channel: Excel IT Pro Discussions forum
Viewing all articles
Browse latest Browse all 11829

Want to change search from column C to R and V in Macro

$
0
0

Presently I can do a  search for numbers in column C.  I want to change the Macro so I can do a search for numbers in columns R and V too.  What do I need to do to my Macro to incorporate the extra 2 columns or even have separate macros and separate sheets?

How is works is you press the big Gray button  and a box appears that says select ranges.   You then high lite with your mouse the cells in C:2  E:2 through C:12  E:12.  Then press okay.  After it finds the different combinations you click next to find the next one.  I would love for the Macro to take all the different ones it finds and place them on a separate sheet so I can see them all at once.  This will also save me time from having to copy and paste them to a new sheet.  If this can be done I would need to keep them in the same columns on the other sheet(s) C R V due to the conditional formatting (I really do not want to have to change all the column numbers  LOL)  The data I will be placing in R and V have a lot of color coding formatting not showed in this example.   I would also like to view 10 rows up and below what it finds.  So, if I want to find lets say 24642 in column C,  R or V and it finds them in rows 21,22,23,24,25 it will also display rows 11-20 and 26-35.

Thank you so much !!!!

Here is a snap shot and the current Macro

Image

Image

Sub test()
    Dim myPtn As Range, r As Range, x, myTxt, mymatch As Range
    Dim ff As String, i As Long, y, flg As Boolean, myAreas As Areas
    Dim Match
    Columns("c:e").Borders.LineStyle = xlNone
    Columns(6).ClearContents
    Set myAreas = Application.InputBox("Select the pattern range(s)", Type:=8).Areas
    For Each myPtn In myAreas
        myTxt = myPtn(1).Value
        Set r = Columns(3).Find(myTxt, , , 1)
        If Not r Is Nothing Then
            ff = r.Address
            Do
                x = Evaluate(r.Resize(myPtn.Rows.Count, 2).Address & "=" & myPtn.Address)
                For i = 1 To 2
                    y = Filter(Application.Transpose(Application.Index(x, 0, i)), False)
                    If UBound(y) <> -1 Then flg = True: Exit For
                Next
                If Not flg Then
                    If mymatch Is Nothing Then
                        Set mymatch = r.Resize(myPtn.Rows.Count, 3)
                    Else
                        Set mymatch = Union(mymatch, r.Resize(myPtn.Rows.Count, 3))
                    End If
                    r.Resize(myPtn.Rows.Count, 3).BorderAround Weight:=xlThick
                    r.Offset(, 3).Value = "x"
                End If
                Set r = Columns(3).FindNext(r): flg = False
            Loop Until ff = r.Address
        End If
    Next
    MsgBox IIf(mymatch Is Nothing, "No match", Replace(mymatch.Address, ",", vbLf)), _
    , IIf(mymatch Is Nothing, "Not ", "") & "Found"
    If Not mymatch Is Nothing Then mymatch.Select
    

End Sub

Private Sub CommandButton1_Click()
Dim c
Dim firstAddress As String
 With Worksheets("Filter").Range("F2", Range("F" & Rows.Count).End(xlUp))
        Set c = .Find("x", LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Offset(, -3).Resize(1, 3).Select
                Set c = .FindNext(c)
                If MsgBox("Next Match?", vbYesNo) = vbNo Then Exit Sub
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub


Viewing all articles
Browse latest Browse all 11829

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>