extract matched data from multiple sheets

[IKHAN]

Hello,

I have ip address in column A sheet1 , Need to extract matched ip address row from multiple sheets(Around 25 sheets) in workbook and paste in new sheet,Would be nice if sheet name is also included for matched ipaddress.

Note :
- Have ip address in different columns in each sheet
- Have ip address in between text in some cells
- ip address may exist in more than 1 sheet


Thanks in advance.

 

[vletm]

IKHAN
Without same layout sample file as You use
You would have to change everything!
... make a good sample file and upload it ...

 

[IKHAN]

Attached sample test file..

Appologize ..Thought had attached in my first post

 

[Marc L]

Hi !

Easy with Range.Find method …
​

 

[vletm]

IKHAN
Something like this ...

 

[IKHAN]

Thanks vletm...

If an easy tweek to code ,Can the matched rows be copied and pasted into new sheet called"output".

If not,Code provided does the work. Thanks again

 

[vletm]

IKHAN
It would be much 'nicer'/easier
if You would write
what do You want and
if those would be same as what would You think.
This code used 'old output' for output (manual cleaning).
Of course matched row can/could do almost anywhere.
I hope that 'Sheet1' and 'output' aren't in that ~25 sheets which should check!

 

[IKHAN]

@vletm

Can hyperlink be inserted for matched data in Sheet1?

It would make it easier to look for the data in sheets as mentioned in first post have 25 sheets and around 2000 rows of data in each sheet.

Private Sub Get_Rows()
    Application.ScreenUpdating = False
    On Error Resume Next
    max_tabs = Worksheets.Count
    s_tab = "Sheet1"
    With Sheets(s_tab)
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        x = .UsedRange.Columns(.UsedRange.Columns.Count).Column
        If y > 1 And x > 1 Then .Range(.Cells(1, 2), .Cells(y, x)).ClearContents
    End With
    For Tabs = 1 To max_tabs
        If Sheets(Tabs).Name <> "Sheet1" Then
            With Sheets(Tabs)
                y_max = .UsedRange.Rows(.UsedRange.Rows.Count).Row
                x_max = .UsedRange.Columns(.UsedRange.Columns.Count).Column
                For y = 1 To y_max
                    For x = 1 To x_max
                        yx = .Cells(y, x)
                        If yx <> Empty Then
                            ys = 1
                            Do
                                chk_a = Sheets(s_tab).Cells(ys, 1)
                                Err.Clear
                                yx = WorksheetFunction.Find(chk_a, yx, 1)
                                If Err.Number = 0 Then
                                    xx = 1
                                    Do
                                        xx = xx + 1
                                    Loop Until Sheets(s_tab).Cells(ys, xx) = Empty
                                    Sheets(s_tab).Cells(ys, xx) = .Name & "= r" & y & "c" & x
                                End If
                                ys = ys + 1
                            Loop Until Sheets(s_tab).Cells(ys, 1) = Empty
                        End If
                    Next x
                Next y
            End With
        End If
    Next Tabs
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

 

[vletm]

IKHAN
As I wrote in #7 Reply ...
maybe You should ReRead it ...
and many things are possible ...

 

[IKHAN]

@vletm

Thank you so much..It works

 

[IKHAN]

@vletm

Thanks for assisting.

Have additional requirement for the code previously provided

If duplicate item is present in column A (Sheet1) , It doesn't extract the info. and case sensitive items aren't extracted

In output tab - Have to copy in same order as sheet1 (See output reqd in outputexample) tab

Attached sample file and help is greatly appreciated!!!

Private Sub Get_Rows()
    Application.ScreenUpdating = False
    On Error Resume Next
    max_tabs = Worksheets.Count
    s_tab = "Sheet1"
    o_tab = "output"
    With Sheets(s_tab)
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        x = .UsedRange.Columns(.UsedRange.Columns.Count).Column
        If y > 1 And x > 1 Then .Range(.Cells(1, 2), .Cells(y, x)).ClearContents
    End With
    For Tabs = 1 To max_tabs
        If Sheets(Tabs).Name <> s_tab And Sheets(Tabs).Name <> o_tab Then
            With Sheets(Tabs)
                y_max = .UsedRange.Rows(.UsedRange.Rows.Count).Row
                x_max = .UsedRange.Columns(.UsedRange.Columns.Count).Column
                For y = 1 To y_max
                    For x = 1 To x_max
                        yx = .Cells(y, x)
                        If yx <> Empty Then
                            ys = 1
                            Do
                                chk_a = Sheets(s_tab).Cells(ys, 1)
                                Err.Clear
                                yx = WorksheetFunction.Find(chk_a, yx, 1)
                                If Err.Number = 0 Then
                                    xx = 1
                                    Do
                                        xx = xx + 1
                                    Loop Until Sheets(s_tab).Cells(ys, xx) = Empty
'                                    Sheets(s_tab).Cells(ys, xx) = .Name & "= r" & y & "c" & x
                                    msg1 = "#" & .Name & "!" & "r" & y & "c" & x
                                    msg2 = .Name & "= r" & y & "c" & x
                                    Hyperlinks.Add anchor:=Sheets(s_tab).Cells(ys, xx), Address:=msg1, TextToDisplay:=msg2
                                    With Sheets(o_tab)
                                        yo = .UsedRange.Rows.Count + 1
                                    End With
                                    .Rows(y & ":" & y).Copy Destination:=Sheets(o_tab).Cells(yo, 1)
                                    Sheets(o_tab).Cells(yo, 12) = .Name
'                                    Sheets(o_tab).Cells(yo, 13) = "r" & y & "c" & x
                                    Hyperlinks.Add anchor:=Sheets(o_tab).Cells(yo, 13), Address:=msg1, TextToDisplay:=msg2
                                End If
                                ys = ys + 1
                            Loop Until Sheets(s_tab).Cells(ys, 1) = Empty
                        End If
                    Next x
                Next y
            End With
        End If
    Next Tabs
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

 

[vletm]

IKHAN
1) I have ip address in column A sheet1. #1
What kind of ip-address are ORANGE or orange?
2) It doesn't extract the info. and case sensitive items aren't extracted
Could You even try to explain underlined terms?
3) Can the matched rows be copied and pasted into new sheet called"output".
... and You just change the idea ... and add some new features ... hmm?
4) As I have already written twice in #7 & #9.
If You don't know what do You want and
if You cannot understand that 'even small details would change everything'.
Do I have time to guess, guess ... not now.

 

[IKHAN]

@vletm

Thanks for taking a look..

1. column A sheet1 has mix of numbers and text (in this case ip address and fruit names) and some of fruit names are in lowercase and uppercase. This data in column A needs to be matched with other sheets (except for "output" and "outputexample" sheets) and to hyperlink the found data in col B sheet 1

2.In code provided earlier - If column A(sheet1) has Lcase fruit name or duplicate name,the matched text\number row from other sheets is not hyperlinked in sheet1 even thou fruit name is present in other sheets(coz it's in Ucase n viceversa)

3.It's same idea which was requested before - Asking to have same order of data in column A sheet1 in "output" sheet. Attached sheet has an "outputexample" tab of exactly what's reqd.

4. Understand small details can change everything - That's the reason am in this forum querying to find solution and if existing code can be modified.

 

[vletm]

IKHAN - You wrote as ... still here is snow and more snow comes daily.
1) It would be different case to 'match' other than ip-addresses.
2) You tried write something ... but where is an answer?
I tried to get answers to two underlined parts of sentences.
If no answer the mission guess guess - not good!
3) Not same idea! You accepted that order and
now ... this would be start from zero! = double/triple work! = waist for me?
4) If You 'understand', why You didn't avoid that?
If You have plenty of extra time then do other has?
'Modify' ... without clear new or even rules
... is not good idea even start to think!
>> #7 Reply <<