lookup, single criteria, multiple sheets, multiple results.

[nitesh123]

someone please put me out of my misery. i have finally broken down after 5 hours of struggle and decided to ask for help.

this is the situation.

sheet 1

Case	date	name	product	price
A	10-oct	john	mobile	1000
B	15-oct	mark	tv	1500

<tbody>
</tbody>

sheet 2

case	date	name	category	purpose
A	16-oct	anthony	phone	repair
D	30-oct	mathew	laptop	fix
E	1-nov	someone	something	something

<tbody>
</tbody>

i will have multiple sheets like this, about 10 in total each having different columns apart from the first 3.
I need to create a macro so that when i enter a case letter (eg A) in a cell and run the macro, it gives me this result in a new sheet.

sheet 3

case	date	name
A	10-oct	john
A	16-oct	anthony

<tbody>
</tbody>

i need only the columns with same headings to be copied. i dont care for the rest. the arrangement of the first 3 columns will be same in all sheets..only the last few columns will be different. but that shouldnt be a problem right? because i dont need those last few different columns.

Im still learning vb so new to the codes, if someone could please write for me a simple to understand code that i can modify.

Thanks.

 

[Warship]

Welcome to the board.
Maybe this will get you started...

Sub GetCases()
    Dim sCaseID As String
    Dim i As Integer, r As Integer
    Dim fnd As Range, fnd1 As String
    Dim arSource As Variant
    Dim shSource As Worksheet
    Dim rgSource As Range
    Dim shDestin As Worksheet
    
    arSource = Array("Sheet1", "Sheet2") 'add Source sheets
    
    sCaseID = InputBox("Enter Case ID")
    
    r = 1
    Set shDestin = Sheets.Add(Before:=Worksheets(1))
    shDestin.Name = """" & sCaseID & """" & " on " & Format(Now, "mm.dd.yy @ hh.mm.ss")
    shDestin.Cells(r, 1) = "Case"
    shDestin.Cells(r, 2) = "Date"
    shDestin.Cells(r, 3) = "Name"
    
    For i = 0 To UBound(arSource)
        Set shSource = Sheets(arSource(i))
        Set rgSource = shSource.Cells.CurrentRegion.Columns(1)
        Set fnd = Nothing
        With rgSource
            Set rgSource = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count)
            Set fnd = .Find(sCaseID, , xlValues, xlWhole)
            If Not fnd Is Nothing Then
                fnd1 = fnd.Address
                Do
                    r = r + 1
                    shDestin.Cells(r, 1).Resize(1, 3) = fnd.Resize(1, 3).Value
                    Set fnd = .FindNext(fnd)
                Loop While fnd.Address <> fnd1
            End If
        End With
    Next i
    shDestin.Cells.Columns.AutoFit
    
    MsgBox """" & sCaseID & """" & " was found " & r - 1 & " times on " & UBound(arSource) + 1 & " sheets"
End Sub

 

[nitesh123]

Thanks, this looks promising. i will try it out at work and let you know

 

[nitesh123]

THANK YOU!!!! this works perfectly as i wanted. it just took 15 mins to customize the code. i appreciate your help. God bless you!

 

[nitesh123]

hey warship...one more question. Suppose i want to sort the results that are pasted in the new sheet by date for example, from smallest to largest. is there a way to include this in the macro so i dont have to manually place the filter and sort each time?

 

[Warship]

You're very welcome.

Add this below: shDestin.Cells.Columns.AutoFit
This sorts by Date then within each date by Name

    shDestin.Sort.SortFields.Clear
    shDestin.Sort.SortFields.Add Key:=Range("B:B"), Order:=xlAscending
    shDestin.Sort.SortFields.Add Key:=Range("C:C"), Order:=xlAscending
    With shDestin.Sort
        .SetRange shDestin.Cells.CurrentRegion
        .Header = xlYes
        .Apply
    End With

 

[pboltonchina]

Hi Warship,

How would I adapt this code if there was more than one result in each sheet and I wanted them all?

Regards

Paul