Split Method: Create Header in Row 1

Dim Ws1 as long, iLoop as Long, sMonths As String, aSplitMe as Variant, aHeaderDump(1 to 1, 1 to 13) as Variant, Destination as Range

sMonths = "RepName^January^February^March^April^May^June^July^August^September^October^November^December^"

'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
    'Split String (Populate Public Array: Row1-Headers)
    aSplitMe = Split(sMonths, "^")

       'Load All non blank values into the Array (Header Position)
    For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
        If aSplitMe(iLoop) <> "" Then aHeaderDump(1, iLoop + 1) = aSplitMe(iLoop)
    Next iLoop
'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

'Dump the Results (Hard Coded WS/Cell location)
'==============================================================
Worksheets(Ws1).Select
Cells.Clear
Set Destination = Range(Worksheets(Ws1).Cells(1, 1).Address)
Destination.Resize(UBound(aHeaderDump, 1), UBound(aHeaderDump, 2)).Value = aHeaderDump
'==============================================================

---

Split Method: 2 Delimiter Pairings (Set Only 1 Variant Object)
  Pattern [~][ValueA][+][ValueB][~] or [|][ValueA][^][ValueB][|]

Sub MultiDelimiterSplitter()
Dim sWord As String, aSplitMe As Variant, iLoop As Long

'Pattern [~][ValueA][+][ValueB][~]
    sWord = "~10+!~~20+@~~30+#~"

'Split into individual pairings:
aSplitMe = Split(sWord, "~")

'Loop through the pairings
For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
    
    'Do not review if there is no value to work with
    If Len(aSplitMe(iLoop)) = 0 Then GoTo gSkipLoopNoValue
    
    'Alternate skip method (Check for 2nd Delimiter)
    'If InStr(1, aSplitMe(iLoop), "+", vbTextCompare) = 0 Then GoTo gSkipLoopNoValue
    
        'Split the Pairing into it's Left/Right Values (Alternate:Instead of Lbound/Ubound: Use [0][1])
        Debug.Print iLoop & "#= Left: " & Split(aSplitMe(iLoop), "+")(LBound(Split(aSplitMe(iLoop), "+")))
        Debug.Print iLoop & "#= Right: " & Split(aSplitMe(iLoop), "+")(UBound(Split(aSplitMe(iLoop), "+")))
        
gSkipLoopNoValue:
Next iLoop

'Release Memory:
Set aSplitMe = Nothing
End Sub

Result:

• 1#= Left: 10
  
  • 1#= Right: !
    
• 3#= Left: 20
  
  • 3#= Right: @
    
• 5#= Left: 30
  
  • 5#= Right: #
    

---

Split Method: Create a Unique List using 2 Keys (Col A / Col B)

After the unique list is created, the code compares the original list against the unique list and loads a 2nd array
     The second array creates a sum total based on the Concatenated Keys


'Assumptions:
    '1) Objects are already defined: Ws1, Ws2, iRe1, iCe1, iSumData
    '2) Keys are in Columns A & B
    '3) Data to SUM is in Column defined using (iSumData)

Dim sList As String, iLoop As Long, aData() As Variant, sTemp As String, iCount As Long
Dim aSplit1 As Variant, aSplit2 As Variant
Dim R1 As Long, R2 As Long
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1).Address)
'===================================================================================================

'===================================================================================================
'Create Unique list using 2 "Keys"
sList = ""
iCount = 1
For iLoop = LBound(aData) + 1 To UBound(aData)
    sTemp = aData(iLoop, 1) & "|" & aData(iLoop, 2)
    If InStr(1, sList, "^" & sTemp & "^", vbTextCompare) = 0 Then
        sList = sList & sTemp & "^"
        iCount = iCount + 1
    End If
Next iLoop
'===================================================================================================

'===================================================================================================
'Load a blank Array to hold the [Split values] from the Unique List
Worksheets(Ws1).Select
aReportKey1Key2 = Range(Worksheets(Ws1).Cells(iRe1 + 1, 1).Address, Worksheets(Ws1).Cells(iRe1 + 1 + iCount, 3).Address)
'===================================================================================================

'===================================================================================================
'Load each Unique value into Array[Report(Col-1/Col2)] based on Split using 2nd delimiter ["|"]
aSplit1 = Split(sList, "^")
For iLoop = LBound(aSplit1) To UBound(aSplit1)
    If aSplit1(iLoop) <> "" Then
        aSplit2 = Split(aSplit1(iLoop), "|")
        aReportKey1Key2(iLoop + 1, 1) = aSplit2(0)
        aReportKey1Key2(iLoop + 1, 2) = aSplit2(1)
    End If
Next iLoop
'===================================================================================================

'===================================================================================================
'Loop through both lists - create a sum in aReportKey1Key2(Col 3)
For R1 = LBound(aData) + 1 To UBound(aData)
    For R2 = LBound(aReportKey1Key2) To UBound(aReportKey1Key2)
    
        'Test uCase(Job) for match
        If UCase(aData(R1, 1)) = UCase(aReportKey1Key2(R2, 1)) Then
            'Test uCase(User) for match
            If UCase(aData(R1, 2)) = UCase(aReportKey1Key2(R2, 2)) Then
            
                'Create a sum of Time Spent - Unique to Job/User
                aReportKey1Key2(R2, 3) = aReportKey1Key2(R2, 3) + aData(R1, iSumData)
            End If
        End If
        
    Next R2
Next R1
'===================================================================================================

'==============================================================
Worksheets(Ws2).Select
Set Destination = Range(Worksheets(Ws2).Cells(1, 1).Address)
Destination.Resize(UBound(aReportKey1Key2, 1), UBound(aReportKey1Key2, 2)).Value = aReportKey1Key2
'==============================================================

Erase aData: Erase aReportKey1Key2