Select the First and Last Values in a Subset of String Values - excel

Question

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.

Answer 1

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

Answer 2

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