Check DT Picker Results, copy sheet into new workbook

Question

my VBA skills aren't the best, if someone could help with the following that would be great.

I have a number of sheets in a workbook that has a date record in the cell range E11:E37.

I'm trying to create a reporting function whereby the user completes a date picker userform, Excel runs a search on the above range in all worksheets in this workbook for a date that falls between the DTPicker1/2 results.

For sheets that return a match, copy all those sheets to a new workbook with name ("Name & current Date".xlsx).

Update: I tried reversing the > and <, no change, think i wrapped in Cdate for the DTPicker Values no results, did both, no results....

Update: code now working but doesnt return a value true where dates in range = 01/06/18 - 14/06/18 where DTP1 = 07/06/18 and DTP2 = 16/06/18. But does return true where DTP1 = 04/06/18 and DTP2 = 08/06/18.

Private Sub CommandButton1_Click()
Dim s As Worksheet, wb As Workbook

For Each s In Worksheets
    If CBool(Application.CountIfs(s.Range("E11:E37"), ">" & 
CDate(DTPicker1.Value), _
                                  s.Range("E11:E37"), "<" & 
CDate(DTPicker2.Value))) Then
        If wb Is Nothing Then
            s.Copy
            Set wb = ActiveWorkbook
        Else
            s.Copy after:=wb.Worksheets(wb.Worksheets.Count)
        End If
    End If
Next s

If wb Is Nothing Then
    MsgBox ("No Records Found")
Else
    wb.SaveAs Filename:="Technicians - Batch Record Report" & Format(Date, 
"ddmmyyyy"), _
          FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub

What's the form look like? Where's the problem? What have you tried? If you hard code the dates does everything else work fine? — ashleedawg
@ashleedawg ... Sorry about this! I am getting a missmatch error on ine: If Range("I11:I37") > DTPicker1.Value And Range("I11:I37") < DTPicker2.Value Then. Because of this, i cant actually get any further to see if the copy functionality works correctly. — Dan Sutton

Unknown Unknown · Accepted Answer · 2018-06-09T15:02:59

Try this to see if it gets you closer to your goal.

Private Sub CommandButton1_Click()
    Dim s As Worksheet, wb as workbook

    For Each s In workSheets
        If cbool(application.countifs(s.Range("I11:I37"), ">" & cdate(DTPicker1.Value), _
                                      s.Range("I11:I37"), "<" & cdate(DTPicker2.Value))) then
            if wb is nothing then
                s.copy
                set wb = activeworkbook
            else
                s.copy after:=wb.worksheets(wb.worksheets.count)
            end if
        end if
    next s

    if wb is nothing then
        MsgBox ("No Records Found")
    else
        wb.SaveAs Filename:="Technicians - Batch Record Report" & Format(Date, "ddmmyyyy"), _
              FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    End If
End Sub

Check DT Picker Results, copy sheet into new workbook

1 Answers