VBA - Find new customers and retention ratio

[ajaf123]

Dear all,

Would be glad if someone could help.
I have a Sheet 1 in which column A has consumer number and column B has month with year (Sep 2020). Every new order means a new row with consumer number and month with year. I want a macro that can identify and summarise new consumers in each month. A new customer in Sep 2020 is one which does not appear in any previous months.
Then I want to compute the percentage of new consumer numbers in say Aug 2020 that placed atleast one order in Sep, Oct and Nov 2020.
I tried using highlight duplicates but failed when a new customer placed multiple orders in first month.

 

[pjmorris]

It might be a bit of learning, but I've investigate PowerQuery and then PowerPivot (you might be able to skip the PowerQuery bit depending on the data) I'm sure that the question is almost the same as shown in a book I read on PowerPivot (can't remember the name, but found it online as a PDF).

This will be a much much more flexible solution than VBA.

 

[EXCEL MAX]

Hello Ajaff123,
here is code that can create new report sheet from two columns in the "Sheet1".
Code transform your data in the new order.
In the report sheet you have filtering option activated and you can easely select wanted month and specific costumer.
In the third column of the report will be shown number of buyings in the selected month for specific costumer.
In the fourth column will be shown percentage as part of selected month selling.
I hope so that is what you looking for.

FillList.xlsm
	A	B
1	ID	DATES
2	A1	dec 21
3	A2	dec 21
4	A1	dec 22
5	A1	dec 23
6	A3	dec 25
7	A3	jan 1
8	A1	jan 1
Sheet1

FillList.xlsm
	A	B	C	D
1	UNIQUE_MONTHS	ID	ID_MONTHLY	ID_MONTHLY_PERCENTAGE
2	12 \ 2020	A1	3	60.00%
3	12 \ 2020	A2	1	20.00%
4	12 \ 2020	A3	1	20.00%
5	1 \ 2021	A3	1	50.00%
6	1 \ 2021	A1	1	50.00%
REPORT

Option Explicit

Sub RetentionRatio()

    Dim varWS As Worksheet, varWS2 As Worksheet
    Dim varRange1 As Range, varRange2 As Range, _
        varRange3 As Range, varRange4 As Range, _
        varRange5 As Range, varRange6 As Range
    Dim varNRows As Long, varNRows2 As Long, _
        varNRows3 As Long, varNRows4 As Long, _
        varCurrentRow As Long
    Dim varNColumns As Integer
    Dim varTempStr As String
    Dim varReport As Boolean
   
    Application.ScreenUpdating = False
    Set varWS = Sheets("Sheet1")
    For Each varWS2 In Worksheets
        If varWS2.Name = "REPORT" Then varReport = True
    Next varWS2
    If varReport = False Then
        Sheets.Add
        ActiveSheet.Name = "REPORT"
        ActiveSheet.Range("A1") = "UNIQUE_MONTHS"
        ActiveSheet.Range("A1").ColumnWidth = 20
        ActiveSheet.Range("B1") = "ID"
        ActiveSheet.Range("B1").ColumnWidth = 10
        ActiveSheet.Range("C1") = "ID_MONTHLY"
        ActiveSheet.Range("C1").ColumnWidth = 15
        ActiveSheet.Range("D1") = "ID_MONTHLY_PERCENTAGE"
        ActiveSheet.Range("D1").ColumnWidth = 30
    End If
    varWS.Activate
    varCurrentRow = 2
    varNRows = varWS.UsedRange.Rows.Count
    varNColumns = varWS.UsedRange.Columns.Count
    Set varRange2 = varWS.Range("B2:B" & varNRows)
    For Each varRange1 In varRange2
        varWS.Cells(varRange1.Row, varNColumns + 1).Formula = _
            "=month(" & varRange1.Address & ")" & " & " & """" & " \ " _
            & """" & " & " & "year(" & varRange1.Address & ")"
        varTempStr = CStr(varWS.Cells(varRange1.Row, varNColumns + 1))
        varWS.Cells(varRange1.Row, varNColumns + 1).Formula = ""
        varWS.Cells(varRange1.Row, varNColumns + 1) = varTempStr
    Next
    varWS.Cells(1, varNColumns + 1) = "MONTHS"
    varWS.Range(Cells(1, varNColumns + 1), Cells(varNRows, varNColumns + 1)). _
        AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=Cells(1, varNColumns + 2), Unique:=True
    varWS.Cells(1, varNColumns + 2) = "UNIQUE_MONTHS"
    varWS.Cells(1, varNColumns + 2).ColumnWidth = 20
    Sheets("REPORT").UsedRange.ClearContents
    Sheets("REPORT").Range("A1") = "UNIQUE_MONTHS"
    Sheets("REPORT").Range("B1") = "ID"
    Sheets("REPORT").Range("C1") = "ID_MONTHLY"
    Sheets("REPORT").Range("D1") = "ID_MONTHLY_PERCENTAGE"
    varNRows2 = varWS.Cells(Rows.Count, varNColumns + 2).End(xlUp).Row
    Set varRange2 = varWS.Range(Cells(2, varNColumns + 2), Cells(varNRows2, varNColumns + 2))
    For Each varRange1 In varRange2
         varWS.Columns(varNColumns + 3).Delete
         varWS.Columns(varNColumns + 3).Delete
         varWS.Cells(1, varNColumns + 2).AutoFilter varNColumns + 1, varRange1
         varWS.Range(Cells(1, varNColumns - 1), Cells(varNRows, varNColumns - 1)). _
            SpecialCells(xlCellTypeVisible).Copy
         varWS.Cells(1, varNColumns + 3).PasteSpecial Paste:=xlValues
         Cells(1, varNColumns + 3) = "ID_MONTHLY"
         varWS.Cells(1, varNColumns + 3).ColumnWidth = 20
         varWS.Range(Cells(1, varNColumns + 3), Cells(varNRows, varNColumns + 3)). _
            AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=Cells(1, varNColumns + 4), Unique:=True
         Cells(1, varNColumns + 4) = "ID_MONTHLY_UNIQUE"
         varWS.Cells(1, varNColumns + 4).ColumnWidth = 20
         varNRows3 = varWS.Cells(Rows.Count, varNColumns + 4).End(xlUp).Row
         varNRows4 = varWS.Cells(Rows.Count, varNColumns + 3).End(xlUp).Row
         Set varRange4 = varWS.Range(Cells(2, varNColumns + 4), Cells(varNRows3, varNColumns + 4))
         Set varRange5 = varWS.Range(Cells(2, varNColumns + 3), Cells(varNRows4, varNColumns + 3))
         Set varRange6 = varWS.Range(Cells(2, varNColumns + 1), Cells(varNRows, varNColumns + 1))
         For Each varRange3 In varRange4
            Sheets("REPORT").Range("A" & varCurrentRow) = varRange1
            Sheets("REPORT").Range("B" & varCurrentRow) = varRange3
            Sheets("REPORT").Range("C" & varCurrentRow) = _
                WorksheetFunction.CountIf(varRange5, varRange3)
            Sheets("REPORT").Range("D" & varCurrentRow) = _
                WorksheetFunction.CountIf(varRange5, varRange3) / _
                WorksheetFunction.CountIf(varRange6, varRange1)
            Sheets("REPORT").Range("D" & varCurrentRow).NumberFormat = "0.00%"
            varCurrentRow = varCurrentRow + 1
         Next
    Next
    varWS.Range(Cells(1, varNColumns + 1), Cells(varNRows, varNColumns + 4)).ClearContents
    varWS.Range("A1").Activate
    Sheets("REPORT").Activate
    Sheets("REPORT").UsedRange.AutoFilter
    Application.ScreenUpdating = True
   
End Sub