VBA - Find new customers and retention ratio

ajaf123

New Member
Joined
Apr 19, 2015
Messages
33
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.
 

Some videos you may like

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

pjmorris

Well-known Member
Joined
Aug 2, 2012
Messages
1,988
Office Version
  1. 2016
Platform
  1. Windows
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

Active Member
Joined
Nov 11, 2020
Messages
384
Office Version
  1. 2007
Platform
  1. Windows
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
AB
1IDDATES
2A1dec 21
3A2dec 21
4A1dec 22
5A1dec 23
6A3dec 25
7A3jan 1
8A1jan 1
Sheet1
FillList.xlsm
ABCD
1UNIQUE_MONTHSIDID_MONTHLYID_MONTHLY_PERCENTAGE
212 \ 2020A1360.00%
312 \ 2020A2120.00%
412 \ 2020A3120.00%
51 \ 2021A3150.00%
61 \ 2021A1150.00%
REPORT

VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,563
Messages
5,625,529
Members
416,116
Latest member
Joemamasuka

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top