here's another one to play with (see comments in code):
Private Sub CommandButton1_Click()
Dim rgFoundend As Range, rgFoundstart As Range, myDataBodyrng As Range, myrngNonEmpty As Range, myrng As Range, rngToCopy As Range
Dim lastrowsheet1_final As Long, LastColumnNo As Long
Dim datestart, dateend
If Cells(1, 4) > Cells(2, 4) Then
MsgBox ("'End Date' must be greater than 'Start Date' Please change")
Exit Sub
End If
datestart = Cells(1, 4)
dateend = Cells(2, 4)
With Worksheets("Vacation Schedule")
'FIND LAST ROW IN SHEET1 FOR COLUMN A, C and D
lastrowsheet1_final = WorksheetFunction.Max(.Cells(.Rows.Count, "a").End(xlUp).Row, .Cells(.Rows.Count, "c").End(xlUp).Row, .Cells(.Rows.Count, "d").End(xlUp).Row) ' find max number of set of last row variables
Set rgFoundstart = .Range("g3:nn3").Find(datestart) 'find cell with start date entered by user
Set rgFoundend = .Range("g3:nn3").Find(dateend) 'find cell with start date entered by user
If rgFoundstart Is Nothing Then 'if not found then message and abort:
MsgBox "Start Date not found"
Exit Sub
End If
If rgFoundend Is Nothing Then 'if not found then message and abort:
MsgBox "End Date not found"
Exit Sub
End If
Set myrng = .Range(rgFoundstart, rgFoundend)
Set myDataBodyrng = myrng.Offset(1).Resize(lastrowsheet1_final - 3)
On Error Resume Next
Set myrngNonEmpty = myDataBodyrng.SpecialCells(xlCellTypeConstants, 23)
On Error GoTo 0
If myrngNonEmpty Is Nothing Then 'if no data between the dates then message and abort:
MsgBox "No data within the dates provided." & vbLf & "Aborting…"
Exit Sub
End If
LastColumnNo = Intersect(.Rows(1), myrngNonEmpty.EntireColumn).Cells.Count + 6 'will be used in the formulae later.
Set rngToCopy = Union(.Range("A3:F" & lastrowsheet1_final), Intersect(myrngNonEmpty.EntireColumn, Union(myDataBodyrng, myrng)))
Intersect(Me.UsedRange, Me.UsedRange.Offset(5)).ClearContents ' Clear destination area before psting new data.
rngToCopy.Copy Range("A6")
'Add formulae in columns E and F (you can remove these next two lines if you want to keep the values in these columns as they are on the source sheet):
Range("E7").Resize(myDataBodyrng.Rows.Count).FormulaR1C1 = "=IF(COUNTIF(RC7:RC" & LastColumnNo & ",""f"")=0,"""",COUNTIF(RC7:RC" & LastColumnNo & ",""f""))"
Range("F7").Resize(myDataBodyrng.Rows.Count).FormulaR1C1 = "=IF(COUNTIF(RC7:RC" & LastColumnNo & ",""v"")=0,"""",COUNTIF(RC7:RC" & LastColumnNo & ",""v""))"
End With
Cells(3, 1) = "Last Updated: " & Date 'only update this date when new data has been placed on the sheet.
End Sub