Get Data from different sheets according to criteria

I am creating an excell VBA tool that can do the following

In sheet summary: when the location is specified (example: London)
and the starting month is entered (example: Jan)
then the ending month is entered (example: May)

When the user presses 'Get Data', the macro will go to the sheets of the month period
specified (in this case: Jan, Feb, Mar, Apr and May) filter the data from those sheets
in order to copy all the rows that match the location column (Column U) in the month sheets.
Finally all those data must be stored in a new sheet created name (the same as location, in this
case 'London').

I need to be able to change the starting month to May and ending to Aug and get the data for this period.

Thanks for the help
Filter-Tool.xls
ZixKAsked:
Who is Participating?
 
gtglonerCommented:
Here is my version, hope this is what you want:
Filter-Tool-1-.xls
0
 
Saurabh Singh TeotiaCommented:
There you go your workbook and code for your reference which will do what you want...
The only change i made which you need to keep in mind is that the start date and end date in the proper date format..like done in the enclosed workbook..and post that it will automatically create worksheet for your search criteria...
Saurabh..

Sub copy()
    Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
    Dim m As Byte, rng As Range, cell As Range
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
 
    Set ws1 = Sheets("Summary")
    If ws1.Cells(3, 3).Value = "" Then
        MsgBox "Please enter a search term to search"
        Exit Sub
    End If
    If ws1.Cells(5, 3).Value = "" Then
        MsgBox " Please Enter Start Month"
        Exit Sub
    ElseIf IsDate(ws1.Cells(5, 3).Value) = False Then
        MsgBox " Please Enter a Valid Start Month"
        Exit Sub
    End If
    If ws1.Cells(7, 3).Value = "" Then
        MsgBox " Please Enter End Month"
        Exit Sub
    ElseIf IsDate(ws1.Cells(7, 3).Value) = False Then
        MsgBox " Please Enter a Valid End Month"
        Exit Sub
    End If
 
    x = ws1.Cells(5, 3).Value
    Sheets(ws1.Cells(3, 3).Value).Delete
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = ws1.Cells(3, 3).Value
    Set ws2 = ActiveSheet
 
    For Each ws In ActiveWorkbook.Worksheets
        For m = Month(ws1.Cells(5, 3).Value) - 1 To Month(ws1.Cells(7, 3).Value) - 1
 
            If Format(DateAdd("m", m, ws1.Cells(5, 3).Value), "mmm") = ws.Name Then
                ws.Select
                ws.Rows(1).copy ws2.Range("A1")
                Set rng = Range("U2:U" & ws.Cells(65536, "U").End(xlUp).Row)
                For Each cell In rng
                    If Trim(UCase(cell.Value)) = Trim(UCase(ws1.Cells(3, 3).Value)) Then
                        cell.EntireRow.copy ws2.Range("A" & ws2.Cells(65536, "A").End(xlUp).Row + 1)
                    End If
                Next cell
            End If
        Next m
    Next ws
    ws2.Select
    Cells.Select
    Selection.EntireColumn.AutoFit
    Range("a1").Select
    ws1.Select
 
    MsgBox "Done"
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
End Sub

Open in new window

Filter-Tool.xls
0
 
ZixKAuthor Commented:
Thanks but I am unable to run the macro.
It is returning an error.
Can you please check why
0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

 
Saurabh Singh TeotiaCommented:
Whats the error message that you are getting..?? and which line it is..?? did you try in the workbook that i uploaded...??
0
 
ZixKAuthor Commented:
Run time error 9
Subscript out of range
coming from the sub copy()
This line:
'    Sheets(ws1.Cells(3, 3).Value).Delete'
0
 
Saurabh Singh TeotiaCommented:
Ahh...just add this one line on line-28 and this will take care of the same...
On Error Resume Next
Saurabh
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.