Extract rows of data from various sheets based on a name selected from a drop down list

[Sparky]

Hi

I have a workbook with 19 worksheets containing product information and when it was actually picked at the work place.
The data is consistent on every sheet running through columns A2 to G2. The data may run up to 65,000 rows.
The employee's (picker) name is in column E of every sheet.

Based on selecting an employee's name from a data validation drop down list I would like to extract the information from the 19 sheets and for them to appear in chronological order thus displaying the date and time order that the different products were picked.

Ideally this information is to be displayed on the same sheet as the drop down list.

Can anyone please help with this query?

 

[dmt32]

Hi

give following a try

Code assumes that each worksheet to be copied has a header row in Row 1 Also, master sheet has same headers.

Place following in a STANDARD module

Sub GetEmployeeData(ByVal sh As Object, ByVal Text As String)
    Dim rng As Range
    Dim ws As Worksheet
    Dim lr As Long
    
    
'clear data
    On Error GoTo myerror
    sh.Range("A6").CurrentRegion.Offset(1, 0).ClearContents
    
    With Application
        .ScreenUpdating = False: .EnableEvents = False
    End With
    
    On Error Resume Next
    For Each ws In Worksheets
        If ws.Name <> sh.Name Then
            lr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
            ws.UsedRange.AutoFilter Field:=5, Criteria1:=Text
            Set rng = ws.AutoFilter.Range
            Set rng = ws.Range("A1").CurrentRegion.Offset(1, 0)
            Set rng = rng.Resize(rng.Rows.Count - 1)
            Set rng = rng.SpecialCells(xlCellTypeVisible)
            If Not rng Is Nothing Then rng.Copy sh.Range("A" & lr)
            ws.Cells.AutoFilter
        End If
nextws:
    Set rng = Nothing
    Next ws
    On Error GoTo 0
    
myerror:
    With Application
        .ScreenUpdating = True: .EnableEvents = True
    End With
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
    
End Sub

Change the Address shown in RED of first cell in Header row of your master sheet.


Place following code in your Master Sheet Code page

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "C4" Then GetEmployeeData Me, Target.Text
End Sub

Change data validation cell address shown in RED as required.

Code should based on filter, copy each sheet to your master sheet - you can then sort the data as required.

Code not fully tested so ensure make backup of your workbook before testing

Hope Helpful

Dave

 

[Sparky]

dmt32

Thanks for taking the time to look at my question.

I have change A6 to A2 (first cell in Header row of the master sheet). I have also changed C4 to K2 (data validation cell for the employee name).


After completing the above it does nothing.

I already have another sheet that gives me the output from the 19 sheets but this is in numeric form, quantities etc. I have used SUMPRODUCT for the formula to look between two predetermined start and finish dates for this and it works well.

Ideally I need the code or a formula to compile a list in chronological order on the master sheet without having to sort the data.


Once again thank you

 

[dmt32]

Hi,
Downside of using Resume next error trap is it masks errors which I suspect are being generated during the filtering part - are any of the sheets being copied protected? if so, unprotect them & see if this resolves.

If still an issue, are you able to place copy of workbook in with sample data in a dropbox?

Dave