Data not shown in remaining rows

[Vincent88]

Hi All,
I need to have the cells from row 3 till the last row in Column B to show preset details but my code gets data in row 3 only. Please help to review what should be corrected.

Sub Sum18()

    Dim rng As Range
    Dim rngRow As Range
    Dim c As Range
    Dim lastrow As Long
    Dim lastcol As Long
    Dim rngCol As Range, rngColRow As Range
    Dim vDayB As Date, vDayE As Date
    Dim vColumnB As Range, vColumnE As Range
    
    ActiveWindow.ScrollColumn = 2
    
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
    
     Set rng = Range(Cells(1, 1), Cells(lastrow, lastcol))
     Set rngCol = rng.Columns(2)
     Set rngColRow = rngCol.Rows(3)
          Debug.Print rngCol.Address
        
        'Find the 1st and last date of month
         vDayB = CDate(Format(ActiveSheet.Name, "0000-00"))
         vDayE = DateAdd("m", 1, vDayB) - 1

        'Find these dates in the range of the dates in the first row
         Set vColumnB = rng.Rows(1).Find(vDayB, , xlFormulas)
         Set vColumnE = rng.Rows(1).Find(vDayE, , xlFormulas)
        
         Debug.Print vColumnB.Address, vColumnE.Address
        
                
        For Each c In rngColRow.Cells
        
        Dim strtot As String, strlve As String, strday As String, streve As String, strnte As String
        
            'Find the 1st and last date of month
              vDayB = CDate(Format(ActiveSheet.Name, "0000-00"))
              vDayE = DateAdd("m", 1, vDayB) - 1
              
            'find network days
            Dim vLastRowHo As Long
            vLastRowHo = Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
            HolidayList = Worksheets("Data").Range("A2:A" & vLastRowHo).Value
            strtot = Application.NetworkDays(vDayB, vDayE, HolidayList)

                  
            strlve = 2
            strday = Application.CountIf(Range(c.Cells(, vColumnB.Column), c.Cells(, vColumnE.Column)), "G")
            streve = 4
            strnte = 5
        
        
        Debug.Print strday
                
        c = "T:" & strtot & " L:" & strlve & " D:" & strday & " E:" & streve & " N:" & strnte
              
        Next c

End Sub

 

[Vincent88]

Hi EXCEL MAX,
Initial test seems work but it does not calculate the first day value !!

 

[Vincent88]

Hi EXCEL MAX,
I hardly managed the job done in standard module and will try the Worksheet Calculate module. I need help to continue the remaining work of this function, please if you have time to review my another thread "Change Cells' color if sum items match" cos I think you will know better than others. Thanks.