Loop VBA through worksheets to check for issues

I am struggling to get a code to loop through a set numbers of worksheets (sheets 10 to 16) for the second sub in the code.

The code was provided by another user (thanks "Taller"!) which i have adapted so it loops through in the first sub but i cannot get the second sub "Checkoverlap" to loop which only works on sheet 10.

The original question is on this link: VBA Create Gantt Chart style timeline from data in 3 column

It was a follow up question, so i have posted it as a new question as i am told that is the correct protocol for.

This is the code I have got to so far.

Sub Demo()
Call SwitchOff
Dim ws As Integer
For ws = 10 To 16

With Sheets(ws).Activate

    Dim i As Long, iCol As Long
    Dim arrData, rngData As Range, olRng As Range
    Dim arrRes, iR As Long, iM As Long, iH As Long
    Dim LastRow As Long, iOffSet As Long
    ' Init. output table
    Columns("F:F").ClearContents
    Columns("F:F").NumberFormatLocal = "hh:mm"
    Range("F2").Value = "6:00"
    Range("F3:F290").Formula = "=R[-1]C+TIMEVALUE(""0:5:0"")"
    ' load header location into Dict
    Const HEADER_START = "G1"
    Dim objDic As Object, c As Range
    Set objDic = CreateObject("scripting.dictionary")
    With Range(HEADER_START, Range(HEADER_START).End(xlToRight))
        .Offset(1).Resize(290).Clear
        For Each c In Range(HEADER_START, Range(HEADER_START).End(xlToRight)).Cells
            objDic(c.Value) = c.Column - Range(HEADER_START).Column
        Next
    End With
    ' load data into an array
    Set rngData = Range("A1").CurrentRegion
    arrData = rngData.Value
    ' loop through data
    For i = LBound(arrData) + 1 To UBound(arrData)
        iH = VBA.Hour(arrData(i, 1))
        iM = VBA.Minute(arrData(i, 1))
        ' round to x5/x0 min.
        If iM Mod 5 <> 0 Then
            iM = iM + (5 - iM Mod 5)
            If iM = 60 Then
                iH = iH + 1
                iM = 0
            End If
        End If
        ' before 6am in the next day
        If iH < 6 Then iH = iH + 24
        iOffSet = ((iH - 6) * 60 + iM) / 5
        If objDic.exists(arrData(i, 3)) Then
            iCol = objDic(arrData(i, 3))
            ' populate output table
            On Error Resume Next
            With Range(HEADER_START).Offset(1, iCol)
                CheckOverlap olRng, .Offset(iOffSet)
                .Offset(iOffSet).Value = arrData(i, 2)
                .Offset(iOffSet).Interior.Color = rgbLightGreen
                .Offset(iOffSet - 1).Interior.Color = rgbOrange
                .Offset(iOffSet - 2).Interior.Color = rgbOrange
                .Offset(iOffSet - 3).Interior.Color = rgbOrange
                .Offset(iOffSet - 4).Interior.Color = rgbOrange
                .Offset(iOffSet - 5).Interior.Color = rgbOrange
            End With
        Else
            MsgBox "Missing team in output header: " & arrData(i, 3)
        End If
    Next i
      If Not olRng Is Nothing Then
        olRng.Interior.Color = vbRed
    End If

End With
Next ws
End Sub

Sub CheckOverlap(ByRef allRng As Range, cRng As Range)
    Dim c As Range
    For Each c In cRng.Offset(-1).Resize(3)
        If Len(c.Value) > 0 Then
            If allRng Is Nothing Then
                Set allRng = Application.Union(c, cRng)
            Else
                Set allRng = Application.Union(allRng, c, cRng)
            End If
        End If
    Next
End Sub

enter image description here

Solution

You don't need to make any change on the second sub "Checkoverlap".

Changes on the first sub are

With Sheets(ws).Activate - Activate is a method. It can't be used in With clause.
Insert .before Range() and Columns() within With...End With to qualify the range object.

Microsoft documentation:

With statement

Option Explicit

Sub Demo()
    Call SwitchOff
    Dim ws As Long
    Dim i As Long, iCol As Long
    Dim arrData, rngData As Range, olRng As Range
    Dim arrRes, iR As Long, iM As Long, iH As Long
    Dim LastRow As Long, iOffSet As Long
    Const HEADER_START = "G1"
    Dim objDic As Object, c As Range
    Set objDic = CreateObject("scripting.dictionary")
    For ws = 10 To 16
        With Sheets(ws)
            objDic.RemoveAll
            ' Init. output table
            .Columns("F:F").ClearContents
            .Columns("F:F").NumberFormatLocal = "hh:mm"
            .Range("F2").Value = "6:00"
            .Range("F3:F290").Formula = "=R[-1]C+TIMEVALUE(""0:5:0"")"
            ' load header location into Dict
            With .Range(HEADER_START, .Range(HEADER_START).End(xlToRight))
                .Offset(1).Resize(290).Clear
                For Each c In .Range(HEADER_START, .Range(HEADER_START).End(xlToRight)).Cells
                    objDic(c.Value) = c.Column - .Range(HEADER_START).Column
                Next
            End With
            ' load data into an array
            Set rngData = .Range("A1").CurrentRegion
            arrData = rngData.Value
            ' loop through data
            For i = LBound(arrData) + 1 To UBound(arrData)
                iH = VBA.Hour(arrData(i, 1))
                iM = VBA.Minute(arrData(i, 1))
                ' round to x5/x0 min.
                If iM Mod 5 <> 0 Then
                    iM = iM + (5 - iM Mod 5)
                    If iM = 60 Then
                        iH = iH + 1
                        iM = 0
                    End If
                End If
                ' before 6am in the next day
                If iH < 6 Then iH = iH + 24
                iOffSet = ((iH - 6) * 60 + iM) / 5
                If objDic.exists(arrData(i, 3)) Then
                    iCol = objDic(arrData(i, 3))
                    ' populate output table
                   ' On Error Resume Next
                    With .Range(HEADER_START).Offset(1, iCol)
                        CheckOverlap olRng, .Offset(iOffSet)
                        .Offset(iOffSet).Value = arrData(i, 2)
                        .Offset(iOffSet).Interior.Color = rgbLightGreen
                        .Offset(iOffSet - 1).Interior.Color = rgbOrange
                        .Offset(iOffSet - 2).Interior.Color = rgbOrange
                        .Offset(iOffSet - 3).Interior.Color = rgbOrange
                        .Offset(iOffSet - 4).Interior.Color = rgbOrange
                        .Offset(iOffSet - 5).Interior.Color = rgbOrange
                    End With
                Else
                    MsgBox "Missing team in output header: " & arrData(i, 3)
                End If
            Next i
            If Not olRng Is Nothing Then
                olRng.Interior.Color = vbRed
            End If
            
        End With
    Next ws
End Sub

Sub CheckOverlap(ByRef allRng As Range, cRng As Range)
    Dim c As Range
    For Each c In cRng.Offset(-1).Resize(3)
        If Len(c.Value) > 0 Then
            If allRng Is Nothing Then
                Set allRng = Application.Union(c, cRng)
            Else
                Set allRng = Application.Union(allRng, c, cRng)
            End If
        End If
    Next
End Sub