Exel macro difference between actual value and debug.print output-CodePudding

First of all i'm sorry for the confusing title but i didn't know how to better explain

Basically i'm expection from an exel macro to have inside of a cell =sum(F2:F3) instead i'm getting =sum(F23:F27) Weird is that Debug.print is showing the expected result

UPDATE: I start to realize that the problem is not the macro but the behave of the output table. Macro is adding a new line to the the table every time that it loops into the dictionary obj . every time that a new line is added all the previous row change according to the formula on the new row. Any idea on how to stop this behave ?

The full code is suppose to sort the sort the datas , extract the names of the staff and return the total hours

Here is a data example:

Here is the full code

`Sub Sort_hours()
'
' Sort staff name and more
'

'
      
    'add rounded column'
    Range("F1").Value = "HoursRounded"
    
    'select range cells with value different than blank'
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    
    'assign a name to the selection'
    ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = _
        "Table1"
        
    'convert into a table'
    Range("Table1[#All]").Select
    ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight14"
    ActiveSheet.ListObjects("Table1").Sort. _
        SortFields.Clear
    ActiveSheet.ListObjects("Table1").Sort. _
        SortFields.Add key:=Range("Table1[[#All],[StaffName]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Dim lst As ListObject, c As Range, rw As ListRow, staff, indx As Long, hoursRoundedColumn As Long, hoursWorkedColumn As Long
    
    Dim arrColors, dictColor As Object, dicFirstRow As Object, dicLastRow As Object, clrIndex As Long
    Set dictColor = CreateObject("scripting.dictionary")
    Set dictFirstRow = CreateObject("scripting.dictionary")
    Set dictLastRow = CreateObject("scripting.dictionary")
    
    Set lst = ActiveSheet.ListObjects("Table1")
    indx = lst.ListColumns("StaffName").Index
    hoursRoundedColumn = lst.ListColumns("HoursRounded").Index
    hoursWorkedColumn = lst.ListColumns("HoursWorked").Index
    
    arrColors = Array(RGB(204, 255, 153), RGB(153, 204, 255), RGB(255, 153, 255), RGB(255, 255, 153), RGB(204, 153, 255)) 'or whatever you like...
    
    For Each rw In lst.ListRows
        With rw.Range
        
            'add rounded hours'
            .Cells(hoursRoundedColumn).Formula = "=MROUND([@HoursWorked],0.5)"
            staff = .Cells(indx).Value
            If Not dictColor.exists(staff) Then 'new name?  Store name and next color
                clrIndex = dictColor.Count Mod (UBound(arrColors)   1) 'mod loops if more values than colors
                
                'add new entry on dicts with new color and first raw'
                dictColor.Add staff, arrColors(clrIndex)
                dictFirstRow.Add staff, .Row
                dictLastRow.Add staff, .Row
            Else
                dictLastRow(staff) = .Row
            End If
            .Interior.Color = dictColor(staff)
        End With
    Next rw
        'add totals table'
    Range("I1").Value = "StaffName"
    Range("J1").Value = "SubTotal"
    Range("K1").Value = "Variance"
    Range("L1").Value = "Totals"
    Range("I1:L1").Select


    ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = _
    "TableTotals"
    
    Dim TableTotals As ListObject
    Set TableTotals = ActiveSheet.ListObjects("TableTotals")
    
    TableTotals.TableStyle = "TableStyleLight14"
    
    'add values to tableTotals'

    Dim staffName As Variant
        For Each staffName In dictFirstRow.keys
            Dim newrow As ListRow
            Set newrow = TableTotals.ListRows.Add
                With newrow
                .Range(1) = staffName
                .Range(2).Formula = "=sum(F" & dictFirstRow(staffName) & ":F" & dictLastRow(staffName) & ")"
                End With
            
            Debug.Print staffName, dictFirstRow(staffName), dictLastRow(staffName)
            Debug.Print "=sum(F" & dictFirstRow(staffName) & ":F" & dictLastRow(staffName) & ")"
    Next staffName

End Sub

CodePudding user response：

See AutoFillFormulasInLists = False below. This is the kind of "magic" behavior which puts me off from using ListObject in the first place.

Sub Sort_hours()
  
    Dim lst As ListObject, ws As Worksheet, TableTotals As ListObject
    Dim c As Range, rw As ListRow, staff, indx As Long
    Dim hoursRoundedColumn As Long, hoursWorkedColumn As Long
    Dim arrColors, dictColor As Object, dictFirstRow As Object
    Dim dictLastRow As Object, clrIndex As Long
    
    Set ws = ActiveSheet 'or whatever
    ws.Range("F1").Value = "HoursRounded" 'add rounded column
    
    'create table from range and sort (grab the reference returned from the Add() )
    Set lst = ws.ListObjects.Add(xlSrcRange, ws.Range("A1").CurrentRegion, , xlYes)
    With lst
        .Name = "Table1"
        .TableStyle = "TableStyleLight14"
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("Table1[[#All],[StaffName]]"), _
                          SortOn:=xlSortOnValues, Order:=xlAscending, _
                          DataOption:=xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    
    Set dictColor = CreateObject("scripting.dictionary")
    Set dictFirstRow = CreateObject("scripting.dictionary")
    Set dictLastRow = CreateObject("scripting.dictionary")
    
    indx = lst.ListColumns("StaffName").Index
    hoursRoundedColumn = lst.ListColumns("HoursRounded").Index
    hoursWorkedColumn = lst.ListColumns("HoursWorked").Index
    
    arrColors = Array(RGB(204, 255, 153), RGB(153, 204, 255), _
                      RGB(255, 153, 255), RGB(255, 255, 153), _
                      RGB(204, 153, 255))
    
    For Each rw In lst.ListRows
        With rw.Range
            .Cells(hoursRoundedColumn).Formula = "=MROUND([@HoursWorked],0.5)" 'add rounded hours
            staff = .Cells(indx).Value
            If Not dictColor.exists(staff) Then 'new name?  Store name and next color
                clrIndex = dictColor.Count Mod (UBound(arrColors)   1) 'mod loops if more values than colors
                'add new entry on dicts with new color and first row
                dictColor.Add staff, arrColors(clrIndex)
                dictFirstRow.Add staff, .Row
            End If
            dictLastRow(staff) = .Row 'always runs...
            .Interior.Color = dictColor(staff)
        End With
    Next rw
        'add totals table'
    ws.Range("I1").Resize(1, 4).Value = Array("StaffName", "SubTotal", "Variance", "Totals")
    
    Set TableTotals = ws.ListObjects.Add(xlSrcRange, ws.Range("I1:L1"), , xlYes)
    TableTotals.Name = "TableTotals"
    TableTotals.TableStyle = "TableStyleLight14"
    '### Prevent formulas from auto-filling ###
    Application.AutoCorrect.AutoFillFormulasInLists = False '<<<<<<<<<
    
    'add values to tableTotals'
    For Each staff In dictFirstRow.keys
        With TableTotals.ListRows.Add()
            .Range(1) = staff
            .Range(2).Formula = "=sum(F" & dictFirstRow(staff) & ":F" & dictLastRow(staff) & ")"
        End With
        Debug.Print staff, dictFirstRow(staff), dictLastRow(staff), _
                    "=sum(F" & dictFirstRow(staff) & ":F" & dictLastRow(staff) & ")"
    Next staff

End Sub