Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Get Data from different sheets according to criteria

Posted on 2009-02-10
6
Medium Priority
?
219 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
0
Comment
Question by:ZixK
  • 3
  • 2
6 Comments
 
LVL 59

Expert Comment

by:Saurabh Singh Teotia
ID: 23600290
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
 

Author Comment

by:ZixK
ID: 23600499
Thanks but I am unable to run the macro.
It is returning an error.
Can you please check why
0
 
LVL 59

Expert Comment

by:Saurabh Singh Teotia
ID: 23600710
Whats the error message that you are getting..?? and which line it is..?? did you try in the workbook that i uploaded...??
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:ZixK
ID: 23600780
Run time error 9
Subscript out of range
coming from the sub copy()
This line:
'    Sheets(ws1.Cells(3, 3).Value).Delete'
0
 
LVL 59

Assisted Solution

by:Saurabh Singh Teotia
Saurabh Singh Teotia earned 800 total points
ID: 23600846
Ahh...just add this one line on line-28 and this will take care of the same...
On Error Resume Next
Saurabh
0
 
LVL 17

Accepted Solution

by:
gtgloner earned 1200 total points
ID: 23600917
Here is my version, hope this is what you want:
Filter-Tool-1-.xls
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

578 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question