Results 1 to 6 of 6
  1. #1
    New Lounger
    Join Date
    Nov 2011
    Posts
    6
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Question VBA find and select rows with specific month

    Hi,

    I have a column with dates from the past 10 years. I want to create a macro with VBA that search for dates which have last month in it.

    For example lets say that there are 10 dates that meet this requirment, the macro have to select these rows and copy them to another sheet.

    So first the macro need to have the search specification: this month minus one. The day is not important only the month and year. Search for all dates that meet this month and year. Then select all these rows.

    Can someone help me with this?

  2. Subscribe to our Windows Secrets Newsletter - It's Free!

    Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,058
    Thanks
    196
    Thanked 766 Times in 700 Posts
    Mattie,

    Welcome to the lounge as a poster.

    Do you want the last month for all years in the list or only the current year?
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  4. #3
    New Lounger
    Join Date
    Nov 2011
    Posts
    6
    Thanks
    0
    Thanked 0 Times in 0 Posts
    No it has to be only the last month of the current year!

  5. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,058
    Thanks
    196
    Thanked 766 Times in 700 Posts
    Mattie,

    The attached worksheet contains the macro below and also the dynamic range name necessary. The number of rows {3000} and columns {2} can be adjusted to fit your data list.

    Dynamic range name: Transactions =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A$1:$A$3000 ),COUNTA(Sheet1!$A$1:$B$1))

    Code:
    Option Explicit
    
    Sub SelectCopyPrevMonth()
    
    'Defined Name Transactions: =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A$1:$A$3000),COUNTA(Sheet1!$A$1:$B$1))
    
        Application.ScreenUpdating = False     'Prevent screen flicker
        [A1].Select
        Selection.AutoFilter
        ActiveSheet.Range("Transactions").AutoFilter Field:=1, Criteria1:= _
            xlFilterLastMonth, Operator:=xlFilterDynamic
        Selection.CurrentRegion.Select
        Selection.Copy
        Sheets("Sheet2").Select
        [A1].Select
        ActiveSheet.Paste
        [A1].Select                          'get rid of selection
        Sheets("Sheet1").Activate
        Application.CutCopyMode = False      'get rid of marque
        Selection.AutoFilter                 'turn off autofilter
        [A1].Select                          'get rid of selection
        
    End Sub
    Please note: This macro will work in Excel 2010 and maybe 2007 but needs more work to work in 2003 to calculate the previous month for the filter since 2003 does not have the xlFilterLastMonth constant defined.
    Attached Files Attached Files
    Last edited by RetiredGeek; 2011-11-28 at 10:06.
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  6. #5
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,058
    Thanks
    196
    Thanked 766 Times in 700 Posts
    Mattie,

    Here's a version that will work in 2003 - 2010.

    Code:
    Sub SelectCopyPrevMonth2003()
    
       Dim iLastMonth   As Integer
       Dim iCurYear     As Integer
       Dim zLastDay     As String
       Dim zStartFltr   As String
       Dim zEndFltr     As String
       
       Application.ScreenUpdating = False
       
       iLastMonth = Month(Now()) - 1
       iCurYear = Year(Now())
       If iLastMonth = 0 Then
         iLastMonth = 12
         iCurYear = iCurYear - 1
       Else
         Select Case iLastMonth
         Case 4, 6, 9, 11
           zLastDay = "30"
         Case 2
           If (iCurYear Mod 4 = 0 And _
              iCurYear Mod 100 <> 0) Or _
              iCurYear Mod 400 = 0 Then
             zLastDay = 29
           Else
             zLastDay = 28
           End If
         Case Else
           zLastDay = "31"
         End Select
       End If
       
       zStartFltr = ">=" & Format(iLastMonth) & "/1/" & Format(iCurYear)
       zEndFltr = "<=" & Format(iLastMonth) & "/" & zLastDay & "/" & Format(iCurYear)
        Range("Transactions").Select
        Selection.AutoFilter Field:=1, _
              Criteria1:=zStartFltr, Operator:=xlAnd, _
              Criteria2:=zEndFltr
              
        Selection.CurrentRegion.Select
        Selection.Copy
        Sheets("Sheet2").Select
        [A1].Select
        ActiveSheet.Paste
        [A1].Select                          'get rid of selection
        Sheets("Sheet1").Activate
        Application.CutCopyMode = False      'get rid of marque
        Selection.AutoFilter                 'turn off autofilter
        [A1].Select                          'get rid of selection
              
    End Sub
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  7. #6
    New Lounger
    Join Date
    Nov 2011
    Posts
    6
    Thanks
    0
    Thanked 0 Times in 0 Posts
    RG, Thank you, I appreciate your help!

    I already succeeded by myself with the following macro:

    Code:
    ' Open overview and copy data into this excel file:
    
        Application.DisplayAlerts = False
        Sheet1.Activate
        Cells.Select
        Selection.Delete Shift:=xlUp
        Range("A1").Select
        Workbooks.Open Filename:= _
            "I:...........xls"
        ActiveWindow.SmallScroll Down:=-9
            Range("A1:AB2754").Sort Key1:=Range("Q1"), Order1:=xlDescending, Header:= _
            xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        Cells.Select
        Range("Q2").Activate
        Selection.Copy
        Windows("bridge document.xls").Activate
        Sheet1.Activate
        Cells.Select
        ActiveSheet.Paste
        Columns("Q:Q").Select
        Selection.NumberFormat = "mm/dd/yyyy"
            Windows("Models.xls").Activate
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
    
    'Select and copy data of past month to sheet 2.
     
     
        Sheet2.Activate
        Rows("2:501").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlUp
        Range("A2").Select
      
        On Error GoTo ErrHandler
        
        Dim dStartDate As Date
        Dim dEndDate As Date
        
        'Collect Start & End Dates
        dStartDate = CDate(DateAdd("m", -1, Date))
        dEndDate = CDate(Now)
        
        
        'Find Dates Between Start Date & End Date and move to sheet 2
        Sheet1.Activate
        
        'Assume column Q contains the dates
        Application.Range("Q1").Select
        
        'Look at every row in column q until it finds an empty cell.
        Do Until ActiveCell.Value = vbNullString
        
        'Verify that the date is between the Start Date & End Date
        If ActiveCell.Value > dStartDate And ActiveCell.Value < dEndDate Then
        
        'If it is, copy the entire row
        ActiveCell.EntireRow.Copy
        
        'Activate sheet 2
        Sheet2.Activate
        
        'Find the first blank row on sheet 2
        Application.Range("A1").Select
        Do Until ActiveCell.Value = vbNullString
        ActiveCell.Offset(1, 0).Select
        Loop
        
        'Paste the row from sheet 1
        ActiveSheet.Paste
        
        'Return to sheet 1
        Sheet1.Activate
        End If
        
        'Move down one row
        ActiveCell.Offset(1, 0).Select
        Loop
        
        'Activate sheet 3
        Sheet3.Activate
    Last edited by jscher2000; 2011-11-29 at 11:30. Reason: Added [code][/code] around code to preserve formatting.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •