Type mismatch error in loop that adds numbers incrementally in column

user_11964645 0
Viewed 52

I'm creating a sub that creates a time sheet for a specific month/year. The code is based on this Microsoft example code. The Microsoft code creates this calendar. I'm amending the code to insert the days of the week in a single column, like this.

My amended code correctly inserts the number 1 in the cell corresponding to the first day of the month, but the loop to add the subsequent day numbers does not work; Cell.Value = Cell.Offset(-1, 0).Value + 1 gives a Type Mismatch Error. Here is my amended code:

Sub Calendar_Genorator1()
Dim WS As Worksheet
Dim MyInput As Variant
Dim StartDay As Variant
Dim DayofWeek As Variant
Dim CurYear As Variant
Dim CurMonth As Variant
Dim FinalDay As Variant
Dim Cell As Range
Dim RowCell As Long
Dim ColCell As Long

Set WS = ActiveWorkbook.ActiveSheet

MyInput = InputBox("Type in Month and year for Calendar ")
    If MyInput = "" Then Exit Sub
       ' Get the date value of the beginning of inputted month.
       StartDay = DateValue(MyInput)
       ' Check if valid date but not the first of the month
       ' -- if so, reset StartDay to first day of month.
       If Day(StartDay) <> 1 Then
           StartDay = DateValue(Month(StartDay) & "/1/" & Year(StartDay))
       End If
       ' Prepare cell for Month and Year as fully spelled out.
       'Range("B3").NumberFormat = "d-mmmm"
       
       'Set headers
       Range("a1").Value = Application.Text(MyInput, "mmmm") & " Time Sheet"
       Range("a2") = "Day"
       Range("b2") = "Date"
       Range("c2") = "Time In"
       Range("d2") = "Time Out"
       Range("e2") = "Hours"
       Range("f2") = "Notes"
       Range("g2") = "Overtime"
       
       'Set weekdays
       Range("a3") = "Sunday"
       Range("a4") = "Monday"
       Range("a5") = "Tuesday"
       Range("a6") = "Wednesday"
       Range("a7") = "Thursday"
       Range("a8") = "Friday"
       Range("a9") = "Saturday"
       
       DayofWeek = Weekday(StartDay)
       ' Set variables to identify the year and month as separate variables.
       CurYear = Year(StartDay)
       CurMonth = Month(StartDay)
       ' Set variable and calculate the first day of the next month.
       FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
       ' Place a "1" in cell position of the first day of the chosen month based on DayofWeek.
       Select Case DayofWeek
           Case 1
               Range("b3").Value = 1
           Case 2
               Range("b4").Value = 1
           Case 3
               Range("b5").Value = 1
           Case 4
               Range("b6").Value = 1
           Case 5
               Range("b7").Value = 1
           Case 6
               Range("b8").Value = 1
           Case 7
               Range("b9").Value = 1
       End Select
       
       'Loop through range b3:b44 incrementing each cell after the "1" cell.
       For Each Cell In Range("b3:b44")
           RowCell = Cell.Row
           ColCell = Cell.Column
           ' Do if "1" is in column B or 2.
           If Cell.Row = 1 And Cell.Column = 2 Then
           ' Do if current cell is not in 1st column.
           ElseIf Cell.Row <> 1 Then
               If Cell.Offset(-1, 0).Value >= 1 Then
                   Cell.Value = Cell.Offset(-1, 0).Value + 1 'Type Mismatch Error here
                   ' Stop when the last day of the month has been entered.
                   If Cell.Value > (FinalDay - StartDay) Then
                       Cell.Value = ""
                       ' Exit loop when calendar has correct number of days shown.
                       Exit For
                   End If
               End If
           End If
       Next
End Sub

I changed the parameters in the loop to work inserting the days incrementally in column B, and I suspect the error is related to that. Any ideas as to why I'm getting an error for Cell.Value = Cell.Offset(-1, 0).Value + 1?

vba excel
1 Answers

Monthly Calendar

Option Explicit

Sub Calendar_Genorator1()

    Const TitleAddress As String = "A1"
    Const HeadersAddress As String = "A2"
    Const DaysAddress As String = "A3"
    Dim Headers As Variant
    Headers = Array("Day", "Date", "Time In", "Time Out", "Hours", _
                    "Notes", "Overtime")

    Dim MyInput As Variant, StartDay As Variant
    MyInput = InputBox("Type in setMonth and year for Calendar ")
    If MyInput = "" Then Exit Sub
    ' Get the date value of the beginning of inputted Month.
    StartDay = DateValue(MyInput)
    ' Check if valid date but not the first of the Month
    ' -- if so, reset StartDay to first day of Month.
    If Day(StartDay) <> 1 Then
        StartDay = DateValue(Month(StartDay) & "/1/" & Year(StartDay))
    End If

    Dim ws As Worksheet
    Set ws = ActiveWorkbook.ActiveSheet
    ' Write title.
    ws.Range(TitleAddress).Value = Application.Text(StartDay, "mmmm") _
                                   & " Time Sheet"
    ' Write headers.
    ws.Range(HeadersAddress).Resize(, UBound(Headers)) = Headers
    ' Write days.
    Dim Target As Variant
    Target = getDDDD_D_US(Month(StartDay), Year(StartDay))
    ws.Range(DaysAddress).Resize(UBound(Target), UBound(Target, 2)).Value = Target

End Sub

Function getDDDD_D_US(setMonth As Long, setYear As Long)
    Dim DaysData As Variant
    DaysData = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", _
                     "Friday", "Saturday")
    Dim Result As Variant
    ReDim Result(1 To 42, 1 To 2)
    ' Write DDDD column.
    Dim i As Long, j As Long, k As Long
    For i = 1 To 6
        k = (i - 1) * 7 + 1
        For j = 0 To 6
            Result(k + j, 1) = DaysData(j)
        Next j
    Next i
    ' Write D column.
    Dim Current As Date
    Current = DateSerial(setYear, setMonth, 1)
    i = Weekday(Current)
    For i = i To i + 27
        Result(i, 2) = Day(Current)
        Current = Current + 1
    Next i
    For i = i To i + 2
        If Month(Current) = setMonth Then
            Result(i, 2) = Day(Current)
            Current = Current + 1
        End If
    Next i
    getDDDD_D_US = Result
End Function
user_98140690
Related