VBA Code:

Sub Example():

    Dim i As Double
    Dim Letter As String
    Dim var1 As Long
    Dim var2 As Long
    Dim Row_For_Table As Integer
    Row_For_Table = 1
    
For i = 1 To 12

    If Cells(i   1, 1).Value <> Cells(i, 1).Value Then
        'MsgBox ("different")
        Letter = Cells(i, 1).Value
        
        var2 = Cells(i, 3).Value
        
        var1 = Cells(i, 2).Value
        
        Range("F" & Row_For_Table).Value = Letter
        
        Range("G" & Row_For_Table).Value = var2 - var1
        
        Row_For_Table = Row_For_Table   1
    Else
        'MsgBox ("same")
    End If
Next i
        
End Sub

I would like to create summary table of A, B, and C with the Values of (14-1), (12-5), and (4-1). I would like to write this is VBA as a template for a bigger project.

Thank you.

CodePudding user response：

This uses a dictionary to do what you are looking for. It assumes your table is sorted by Column A.

    Dim i As Long
    Dim lr As Long
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    With Sheets("Sheet1") 'Change as needed
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row 'Lastrow
        For i = 1 To lr   1
            If Not dict.exists(.Cells(i, 1).Value) Then 'Key doesn't exist
                dict.Add .Cells(i, 1).Value, .Cells(i, 2).Value 'Add key and first value
                If i > 1 Then 'Avoid out of range errors
                    dict(.Cells(i - 1, 1).Value) = .Cells(i - 1, 3).Value - dict(.Cells(i - 1, 1).Value) 'Subtract old value from new value
                End If
            End If
        Next i
        
        Dim key As Variant
        i = 1
        For Each key In dict
            .Cells(i, 6).Value = key 'place values
            .Cells(i, 7).Value = dict(key)
            i = i   1
        Next key
    End With

CodePudding user response：

This also uses a dictionary and should work for multiple columns.

Option Explicit

Sub StuffDo()
Dim rng As Range
Dim arrData As Variant
Dim ky As Variant
Dim dicLetters As Object
Dim arrNumbers()
Dim cnt As Long
Dim idxCol As Long
Dim idxRow As Long

    arrData = Sheets("Sheet1").Range("A1").CurrentRegion.Value

    Set dicLetters = CreateObject("Scripting.Dictionary")

    For idxRow = LBound(arrData, 1) To UBound(arrData, 1)
        For idxCol = LBound(arrData, 2)   1 To UBound(arrData, 2)
            ky = arrData(idxRow, 1)

            If Not dicLetters.exists(ky) Then
                arrNumbers = Array(arrData(idxRow, idxCol))
            Else
                arrNumbers = dicLetters(ky)
                cnt = UBound(arrNumbers)   1
                ReDim Preserve arrNumbers(cnt)
                arrNumbers(cnt) = arrData(idxRow, idxCol)
            End If
            dicLetters(ky) = arrNumbers
        Next idxCol
    Next idxRow

    Set rng = Range("A1").Offset(, Range("A1").CurrentRegion.Columns.Count   2)
    
    For Each ky In dicLetters.keys
        arrNumbers = dicLetters(ky)
        rng.Value = ky
        rng.Offset(, 1) = arrNumbers(UBound(arrNumbers))
        rng.Offset(, 2) = arrNumbers(0)
        Set rng = rng.Offset(1)
    Next ky
    
End Sub