Sub CopyMonthsData()
Dim i&
Dim lRow&
Dim ws As Worksheet
Dim ws2CopyTo As Worksheet
Dim boolWsExists As Boolean
Dim monthNo&
Dim newRow&
Dim strMonth$
Const mainWsName$ = "SHEET1"
boolWsExists = False
strMonth = Application.InputBox("Type in a month", "Data Entry", Default:=Format(Month(Date), "mmmm"))
If strMonth = vbNullString Then
MsgBox "Month was not provided", vbCritical, "InfoLog"
Exit Sub
End If
Select Case LCase(strMonth)
Case Is = "january"
monthNo = 1
Case Is = "february"
monthNo = 2
Case Is = "march"
monthNo = 3
Case Is = "april"
monthNo = 4
Case Is = "may"
monthNo = 5
Case Is = "june"
monthNo = 6
Case Is = "july"
monthNo = 7
Case Is = "august"
monthNo = 8
Case Is = "september"
monthNo = 9
Case Is = "october"
monthNo = 10
Case Is = "november"
monthNo = 11
Case Is = "december"
monthNo = 12
Case Else:
monthNo = 0
End Select
If monthNo = 0 Then
MsgBox "The privided text is not a month: " & strMonth, vbCritical, "InfoLog"
Exit Sub
End If
With Worksheets(mainWsName)
lRow = .Range("A1").CurrentRegion.Rows.Count
If lRow = 1 Then
MsgBox "No data found!", vbCritical, "InfoLog"
Exit Sub
End If
'find if typed in worksheet exists
For Each ws In Worksheets
If LCase(ws.Name) = LCase(strMonth) Then
Set ws2CopyTo = ws
boolWsExists = True
Exit For
End If
Next ws
If boolWsExists = False Then
MsgBox "Typed in worksheet does not exist: " & strMonth, vbCritical, "InfoLog"
Exit Sub
End If
For i = 2 To lRow
If Month(.Cells(i, "A")) = monthNo Then
newRow = ws2CopyTo.Range("A1").CurrentRegion.Rows.Count + 1
.Cells(i, "A").EntireRow.Copy ws2CopyTo.Cells(newRow, "A")
End If
Next i
End With
MsgBox "Done", vbInformation, "InfoLog"
End Sub