We help IT Professionals succeed at work.

We've partnered with Certified Experts, Carl Webster and Richard Faulkner, to bring you two Citrix podcasts. Learn about 2020 trends and get answers to your biggest Citrix questions!Listen Now

x

Get Data from different sheets according to criteria

Medium Priority
241 Views
Last Modified: 2013-11-25
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
Comment
Watch Question

CERTIFIED EXPERT
Top Expert 2015

Commented:
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

Author

Commented:
Thanks but I am unable to run the macro.
It is returning an error.
Can you please check why
CERTIFIED EXPERT
Top Expert 2015

Commented:
Whats the error message that you are getting..?? and which line it is..?? did you try in the workbook that i uploaded...??

Author

Commented:
Run time error 9
Subscript out of range
coming from the sub copy()
This line:
'    Sheets(ws1.Cells(3, 3).Value).Delete'
CERTIFIED EXPERT
Top Expert 2015
Commented:
Ahh...just add this one line on line-28 and this will take care of the same...
On Error Resume Next
Saurabh

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts
Commented:
Here is my version, hope this is what you want:
Filter-Tool-1-.xls
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.