Align rows to match column - database

Question

Problem
How can you horizontally align values in separate columns, and apply a dynamic formula? Preemptive thank you for any help or clues! The code pasted below works, in so far as it reaches halfway to the end destination. But how to accomplish the last two objectives?
1) Sum each range
2) Align the ranges horizontally
A sample sheet containing customer id, item and prices. Sales from Monday on the left, Tuesday on the right.
Current results
Desired results
Align cust id on rows A and E, with an associated sum. Notice how each yellow line contains cust id for identification, as well as associated Sum total.
Existing VBA Code
Sub AlignAndMatch()
'backup sheet
ActiveSheet.Copy after:=Sheets(Sheets.Count)
'Insert rows where current cell <> cell above
Dim i, totalrows As Integer
Dim strRange As String
Dim strRange2 As String
'----------------------------------------
'Monday sort table
Range("A2:C65536").Select
Selection.Sort Key1:=Range("A2:C65536"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Monday insert loop
totalrows = ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Row
i = 0
Do While i <= totalrows
i = i + 1
strRange = "A" & i
strRange2 = "A" & i + 1
If Range(strRange).Text <> Range(strRange2).Text Then
Range(Cells(i + 1, 1), Cells(i + 2, 3)).Insert xlDown 'think cells ~A1:C2 insert
totalrows = ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Row
i = i + 2 'for insert 2 rows
End If
Loop
'Monday footer row loop
totalrows = ActiveSheet.Range("A65536").End(xlUp).Offset(0, 0).Row
i = 0
Do While i <= totalrows
i = i + 1
If IsEmpty(Range("A" & i).Value) And Not IsEmpty(Range("A" & i + 1).Value) Then
Range("A" & i).Value = Range("A" & i + 1).Value
Range("B" & i).Value = "Sum"
End If
Loop
'----------------------------------------
'Tuesday sort table
Range("E2:G65536").Select
Selection.Sort Key1:=Range("E2:G65536"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Tuesday insert loop
totalrows = ActiveSheet.Range("E65536").End(xlUp).Offset(0, 0).Row
i = 0
Do While i <= totalrows
i = i + 1
strRange = "E" & i
strRange2 = "E" & i + 1
If Range(strRange).Text <> Range(strRange2).Text Then
Range(Cells(i + 1, 5), Cells(i + 2, 7)).Insert xlDown 'think cells ~A1:C2 insert
totalrows = ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Row
i = i + 2 'for insert 2 rows
End If
Loop
'Tuesday footer row loop
totalrows = ActiveSheet.Range("E65536").End(xlUp).Offset(0, 0).Row
i = 0
Do While i <= totalrows
i = i + 1
If IsEmpty(Range("E" & i).Value) And Not IsEmpty(Range("E" & i + 1).Value) Then
Range("E" & i).Value = Range("E" & i + 1).Value
Range("F" & i).Value = "Sum"
End If
Loop
End Sub

Answer 1

If I needed something like that I might think twice what I want and why: if the original day lists don't come from somehwere, you could put everything into one list and make some pivots...
But. Here's some idea, playing with the arrays again and there's probably work to do, but does this help:
Option Base 1
Sub ReLists()
Dim ListSheet As Worksheet
Dim DayCorners() As Range
Dim Day()
Dim Days As Integer
Dim CustIDs()
Dim CustomerRow() 'for placement in the final list
Dim DayList()
Dim MaxCustIDs As Integer
Dim NewCustID As Boolean
Days = 2
MaxCustIDs = 5
ReDim DayCorners(Days)
ReDim Day(Days)
ReDim CustomerRow(MaxCustIDs + 2)
CustomerRow(1) = 0
ReDim CustIDs(MaxCustIDs)
ReDim DayItems(1, 1)
Set ListSheet = Worksheets("Sheet1")
Set DayCorners(1) = ListSheet.Range("A2")
Set DayCorners(2) = ListSheet.Range("E2")
For d = 1 To Days
With ListSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=DayCorners(d)
.SetRange Range(DayCorners(d), DayCorners(d).End(xlDown).Offset(0, 2))
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
Day(d) = Range(DayCorners(d), DayCorners(d).End(xlDown).Offset(0, 2))
If UBound(Day(d), 1) > UBound(DayItems, 2) Then
ReDim DayItems(Days, UBound(Day(d)))
End If
Next d
CustIDCount = 0
For d = 1 To Days
For r = 1 To UBound(Day(d), 1)
NewCustID = True
For u = 1 To UBound(CustIDs)
If CustIDs(u) = Day(d)(r, 1) Then NewCustID = False
Next u
If NewCustID Then
CustIDCount = CustIDCount + 1
CustIDs(CustIDCount) = Day(d)(r, 1)
End If
Next r
Next d
With Worksheets.Add(After:=Worksheets(ListSheet.Index))
Set DayCorners(1) = .Range("A2")
Set DayCorners(2) = .Range("E2")
End With
ReDim DayList(Days, CustIDCount, 100, 3)
For d = 1 To Days
For c = 1 To CustIDCount
rc = 1
For r = 1 To UBound(Day(d), 1)
If Day(d)(r, 1) = CustIDs(c) Then
DayList(d, c, rc, 1) = Day(d)(r, 1)
DayList(d, c, rc, 2) = Day(d)(r, 2)
DayList(d, c, rc, 3) = Day(d)(r, 3)
rc = rc + 1
End If
Next r
If CustomerRow(c) + rc + 2 > CustomerRow(c + 1) Then
CustomerRow(c + 1) = CustomerRow(c) + rc + 1
End If
Next c
If CustomerRow(c - 1) + rc + 2 > CustomerRow(c) Then
CustomerRow(c) = CustomerRow(c) + rc
End If
Next d
For d = 1 To Days
With DayCorners(d).Offset(-1, 0).Range("A1:C1")
.Value = Array("cust id", "item", "Price")
'formatting
End With
For c = 1 To CustIDCount
SumFormula = "=SUM(R[1]C:R[" & (CustomerRow(c + 1) - CustomerRow(c) - 1) & "]C)"
With DayCorners(d).Offset(CustomerRow(c), 0).Range("A1:D1")
If Not IsEmpty(DayList(d, c, 1, 1)) Then
.Value = Array(CustIDs(c), "Sum", SumFormula, "")
End If
.Interior.Color = 65535
End With
For rc = 1 To UBound(Day(d), 1)
If IsEmpty(DayList(d, c, rc, 1)) Then Exit For
DayCorners(d).Offset(CustomerRow(c) + rc, 0) = DayList(d, c, rc, 1)
DayCorners(d).Offset(CustomerRow(c) + rc, 1) = DayList(d, c, rc, 2)
DayCorners(d).Offset(CustomerRow(c) + rc, 2) = DayList(d, c, rc, 3)
Next rc
Next c
Next d
End Sub

Answer 2

I believe the solution is to simulate an SQL full outer join, via VBA. I'll start hacking away at it. Should be a fun personal challenge. I'll try to update this answer once I find the final solution.
The direction I'm following is here.