Summarize data using Excel VBA - excel

Question

I am a beginner to VBA. On sheet one I have data formatted like this:
SHEET 1
What I want to do is use VBA to spit out the following graph which dynamically populates the region depending on how many it finds:
SHEET 2
This is my first bit of VBA so I am struggling a bit. This is my idea of how to approach this problem:
My idea was to scroll down the string in my data in sheet1 col A and determine if it's a date we have seen before or not:
Public Sub Test()
ActiveSheet.Range("Sheet1!A1:A5000").AdvancedFilter Action:=xlFilterCopy, CopyToRange.Range("Sheet2!A1"), Unique:=True
End Sub
Questions
Is this flow diagram taking the right approach?
If so, how do I implement this kind of "Is this unique, if so do this, if not do this" kind of setup.
How can I start this code so I have something to build on?
This is what I have so far:
https://gist.githubusercontent.com/employ/af67485b8acddce419a2/raw/6dda3bb1841517731867baec56a0bf2ecf7733a7/gistfile1.txt

Answer 1

For different approach please see below:
Sheet 1 layout (Source):
Sheet 2 Layout (Target):
Sub SalesRegion()
Dim ws1, ws2 As Worksheet
Dim wb As Workbook
Dim ws1LastRow, ws2LastRow, salesVal As Long
Dim destFind, dateFind As Range
Dim destStr As String
Dim dateStr As Date
Dim targetCol, targetRow As Long
Set wb = ActiveWorkbook '<- Your workbook
Set ws1 = wb.Sheets("Sheet1") '<- Your source worksheet
Set ws2 = wb.Sheets("Sheet2") '<- Your destination worksheet
ws1LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To ws1LastRow
destStr = ws1.Range("C" & i).Value
dateStr = ws1.Range("A" & i).Value
salesVal = ws1.Range("B" & i).Value
With ws2.Rows("1:1") '<- row on destination sheet which contains countries
Set destFind = .Find(What:=destStr, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not destFind Is Nothing Then
targetCol = destFind.Column
With ws2.Columns("A:A") '<- Column on destination sheet which contains months
'You may need to adjust date format below depending on your regional settings
Set dateFind = .Find(What:=Format(ws1.Range("A" & i).Value, "MMM-yy"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not dateFind Is Nothing Then
targetRow = dateFind.Row
ws2.Cells(targetRow, targetCol).Value = ws2.Cells(targetRow, targetCol).Value + salesVal
Else
ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = dateStr
targetRow = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
ws2.Cells(targetRow, targetCol).Value = salesVal
End If
End With
Else
ws2.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Value = destStr
targetCol = ws2.Cells(1, Columns.Count).End(xlToLeft).Column
With ws2.Columns("A:A") '<- Column on destination sheet which contains months
'You may need to adjust date format below depending on your regional settings
Set dateFind = .Find(What:=Format(ws1.Range("A" & i).Value, "MMM-yy"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not dateFind Is Nothing Then
targetRow = dateFind.Row
ws2.Cells(targetRow, targetCol).Value = ws2.Cells(targetRow, targetCol).Value + salesVal
Else
ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = dateStr
targetRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
ws2.Cells(targetRow, targetCol).Value = salesVal
End If
End With
End If
End With
Next
End Sub

Answer 2

First, I agree with the others that you should look for a solution using the built-in capabilities of the Pivot Table.
Since you've mentioned that it does not meet your expectations, I threw together some code that works to summarize the data as you've requested. Let me know if it does the trick, if you need any added help adjusting it for your needs, or if you have any other general questions.
Sub SummarizeInNewSheet()
Dim wsOrigin As Worksheet
Dim wsDest As Worksheet
Dim rngOrigin As Range
Dim oDict As Object
Dim cel As Range
Dim rngLocations As Range
Dim nLastRow As Long
Dim nLastCol As Long
Dim rngInterior As Range
Dim rngAllDates As Range
Dim rngAllLocations As Range
Dim rngAllSales As Range
Application.ScreenUpdating = False
Set wsOrigin = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
Set rngOrigin = wsOrigin.Range("A1").CurrentRegion
Intersect(rngOrigin, wsOrigin.Columns(1)).Copy wsDest.Range("A1")
wsDest.Range(wsDest.Range("A1"), wsDest.Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlYes
Set oDict = CreateObject("Scripting.Dictionary")
Set rngLocations = wsDest.Range("B1")
For Each cel In Intersect(rngOrigin, wsOrigin.Columns(3))
If cel.Row = 1 Then
Else
If oDict.exists(cel.Value) Then
'Do nothing for now
Else
oDict.Add cel.Value, 0
rngLocations.Value = cel.Value
Set rngLocations = rngLocations.Offset(, 1)
End If
End If
Next cel
nLastRow = wsDest.Cells(Rows.Count, 1).End(xlUp).Row
nLastCol = wsDest.Cells(1, Columns.Count).End(xlToLeft).Column
Set rngInterior = wsDest.Range(wsDest.Range("B2"), wsDest.Cells(nLastRow, nLastCol))
Set rngAllDates = wsOrigin.Range(wsOrigin.Range("A2"), wsOrigin.Range("A2").End(xlDown))
Set rngAllSales = wsOrigin.Range(wsOrigin.Range("B2"), wsOrigin.Range("B2").End(xlDown))
Set rngAllLocations = wsOrigin.Range(wsOrigin.Range("C2"), wsOrigin.Range("C2").End(xlDown))
For Each cel In rngInterior
cel.Value = Application.WorksheetFunction.SumIfs(rngAllSales, rngAllDates, wsDest.Cells(cel.Row, 1), rngAllLocations, wsDest.Cells(1, cel.Column))
Next cel
Application.ScreenUpdating = True
End Sub