Need to loop code for certain worksheets in workbook

**longbow007** · 05-27-2010, 05:59 PM

Hello, could some one please help me with the following:

I know I have posted this problem before, but after doing more research I think I discovered why I could never get any code to work properly. The problem was with how Excel treats dates.

I have managed to put together part of an Excel 2003 macro that does the following:

I have tested the following code and it does filter my data properly.

Sub FilterByDateRange()
'
Dim DateIni As Date
Dim DateEnd As Date
Dim DateIniAF As Long
Dim DateEndAF As Long
'
DateIni = InputBox("Date From in dd-mmm-yy format")
DateIni = DateSerial(Year(DateIni), Month(DateIni), Day(DateIni))
DateIniAF = DateIni
DateEnd = InputBox("Date To in dd-mmm-yy format")
DateIni = DateSerial(Year(DateIni), Month(DateIni), Day(DateIni))
DateEndAF = DateEnd
Sheets("Z-1").Range("A1").AutoFilter Field:=40, Criteria1:=">=" & DateIniAF, Operator:=xlAnd, Criteria2:="<=" & DateEndAF
Sheets("Z-1").Range("A1").AutoFilter Field:=43, Criteria1:="VACANT"
LastRw = wsDATA.Range("A" & wsDATA.Rows.Count).End(xlUp).Row

End Sub

It asks the user for the DateFrom and DateTo

With this input, it filters worksheet named: Z-1 in column AN

It then filters in the same worksheet column AQ for any cells with the value of: VACANT

As an example, I entered the date value of: 27-May-10 for DateFrom
I entered the date value of: 26-Jun-10 for DateTo

What I need it to do is the following:

I need the results of the filtered data to be copied to worksheet named: 1 Mth at cell A3

I then need a loop to repeat the same procedure for the remaining worksheets that have the letter "Z" in their name.

That is worksheets named: Z-1, Z-2, Z-3, Z-4, Z-5, Z-7, Z-9, Z-10, Z-11, Z-12, Z-15, Z-17, Z-18, Z-19 AND Z-20.

I have attached my workbook with "dummy-data".

If some one could please help me, it would be greatly appreciated.

Kind regards,

Chris

**antoka05** · 05-27-2010, 07:01 PM

See attached file.
This is the macro I used:

Sub FilterByDateRange()
   '
   Dim DateIni As Date
   Dim DateEnd As Date
   Dim DateIniAF As Long
   Dim DateEndAF As Long
   Dim sh As Worksheet, freeRow As Long, maxRow As Long
   Dim sh1 As Worksheet
   Dim found As Range
   '
   DateIni = InputBox("Date From in dd-mmm-yy format")
   DateIni = DateSerial(Year(DateIni), Month(DateIni), Day(DateIni))
   DateIniAF = DateIni
   
   DateEnd = InputBox("Date To in dd-mmm-yy format")
   DateEnd = DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd))
   DateEndAF = DateEnd
   
   Set sh1 = ThisWorkbook.Sheets("1 Mth")
   For Each sh In ThisWorkbook.Sheets
      If LCase(sh.Name) Like "z*" Then
         sh.AutoFilterMode = False
         Set found = sh.Range("a:a").Find("POSITION NUMBER", LookIn:=xlValues)
         If Not found Is Nothing Then
            sh.Range(found.Row & ":" & Rows.Count).AutoFilter Field:=40, Criteria1:=">=" & DateIniAF, Operator:=xlAnd, Criteria2:="<=" & DateEndAF
            sh.Range(found.Row & ":" & Rows.Count).AutoFilter Field:=43, Criteria1:="VACANT"
            
            freeRow = sh1.Cells(Rows.Count, "a").End(xlUp).Row + 1
            maxRow = sh.UsedRange.Rows.Count + sh.UsedRange.Row - 1
            sh.Range(found.Row + 1 & ":" & maxRow).SpecialCells(xlCellTypeVisible).Copy sh1.Cells(freeRow, "a")
         End If
      End If
   Next sh

End Sub

Regards,
Antonio