New to arrays - Array not returning values

[Beemerang]

Hello all,

I am trying to use arrays for the first time and I am flummoxed! Although the array seems to be populating when I write the values to it, any attempt to read those values fail as nothing is returned. Now I KNOW that this is my stupidity and I have checked and rechecked the code that I cobbled together but I simply cannot see where I am going wrong. Any help would be hugely appreciated.

I would like to write the array to a range in Sheet1 but no values are returned and when I test with debug.print it seems that the array contains only 3 or 4 values instead of the dozens that were written to it. Please forgive my messy code!

'====DECLARE VARIABLES:'Declare Counter variables
'Dim x As Integer
Dim SheetCounter As Integer     'Used to count sheets
Dim MasterCount As Long         'Used to store number of unique keys
Dim RowCounter As Long          'Used to count rows in ranges
Dim TxnCounter As Integer       'Used to count transactions


'Declare Database variables
Dim UniqueKey As String         'Stores unique customer/household id
Dim MonthAdded As String        'Stores the month in which a household becomes a customer


'Declare Range variables
Dim MasterList As Range         'Holds the master list of unique keys
Dim DataRange As Range          'Holds the active range being worked on
Dim RefCell As Range            'Hold the address of the cell being referenced in a data range


'Declare Calculation variables
Dim CalcNew As Integer          'Stored calculation of new customers for a month
Dim CalcRetained As Integer     'Stores calculation of retained customers for a month
Dim KeyResult As Variant


'Declare Arrays:
Dim MasterArray As Variant      'Stores MasterArray list of unique keys
Dim TxnArray As Variant         'Stores TxnArray month's list of transactions
Dim CalcArray As Variant        'Stores results of calculations


'SET APPLICATION STATE:
'Application.ScreenUpdating = False     'To stop screen flicker
'Application.Calculation = xlCalculationManual      'Stop automatic calculation
'MsgBox Sheets.Count & "sheets in workbook"     'For testing purposes only


'INITIALISE CALCULATION ARRAY:
CalcArray = Array("Sep 2018", "Oct 2018", "Nov 2018", "Dec 2018", "Jan 2019", "Feb 2019", "Mar 2019", "Apr 2019", "May 2019", "Jun 2019", "Jul 2019", "Aug 2019")
ReDim CalcArray(Sheets.Count, 2)




'READ MASTER LIST INTO ARRAY:
Sheets("Master List").Activate
Set DataRange = ActiveSheet.Range("A1:B1", Range("B1").End(xlDown))
DataRange.Select
MasterCount = DataRange.Rows.Count
MasterArray = DataRange.Value2


'COMPARE UNIQUE IDs ON MONTHLY TRANSACTION SHEETS TO MASTER LIST:
SheetCounter = Sheets.Count
For Each Sheet In Sheets
    CalcNew = 0
    CalcRetained = 0
    If Sheets(SheetCounter).Name = "Report" Or Sheets(SheetCounter).Name = "LTV" Or Sheets(SheetCounter).Name = "Master List" Or Sheets(SheetCounter).Name = "Sheet1" Then
        'Do nothing for utility sheets
    Else
    'MsgBox "Now processing sheet " & Sheets(SheetCounter).Name
        Sheets(SheetCounter).Activate
        MonthAdded = ActiveSheet.Name
        Set DataRange = ActiveSheet.Range("A2", Range("A2").End(xlDown))
        RowCounter = DataRange.Rows.Count
        TxnCounter = 0
        On Error Resume Next
        
        For Each RefCell In DataRange
            If RefCell.Offset(0, 1) = "Settled Successfully" Then               'If the txn was settled successfully, generate the client key and check if exists
                UniqueKey = RefCell.Offset(0, 27) & RefCell.Offset(0, 30)       'Generate the unique customer key from billing address and zipcode
                'UniqueKey = "TEST DATA"
                
                KeyResult = IsInArray2DIndex(UniqueKey, MasterArray)
                If KeyResult(0) >= 0 And KeyResult(1) >= 0 Then
                    Debug.Print Chr(34) & MasterArray(KeyResult(0), KeyResult(1)) & Chr(34) & " exists in array at row: " & KeyResult(0) & ", col: " & KeyResult(1)
                    CalcRetained = CalcRetained + 1
                Else
                'IF THE GENERATED KEY DOES NOT EXIST IN THE MASTER LIST:
                    Debug.Print UniqueKey & " does not exist in array"
                    'ReDim Preserve MasterArray(MasterCount + 1, 2)           'Expand the existing Master key array to add in the new keys
                    MasterArray(MasterCount, 1) = UniqueKey                     'Write unique key to master list
                    MasterArray(MasterCount, 2) = MonthAdded                    'Write month added to master list
                    CalcNew = CalcNew + 1                                       'Count as new customer/household
                    Debug.Print MasterArray(MasterCount, 1) & " WAS WRITTEN TO ARRAY FOR " & MasterArray(MasterCount, 2) & " AT POSITION " & MasterCount
                End If
                
            End If
            MasterCount = MasterCount + 1
            TxnCounter = TxnCounter + 1                                 'Increment counter
            'ReDim MasterArray(MasterCount, 2)
           '[ Debug.Print MasterArray(MasterCount, 1) & " | " & MasterArray(MasterCount, 2)
            
        Next
        On Error GoTo 0
    End If
    'STORE THE CALCULATED VALUES FOR REPORTS:
    CalcArray(SheetCounter, 0) = MonthAdded
    CalcArray(SheetCounter, 1) = CalcNew
    CalcArray(SheetCounter, 2) = CalcRetained
Next Sheet


'====WRITE THE UPDATED MASTER LIST====


Worksheets("Sheet1").Activate
'OPTION A
'Set Summary = Worksheets("Sheet1").Range("A1").Resize(UBound(MasterArray, 1) + 1)
'Summary = MasterArray
For MasterCount = 1 To UBound(MasterArray, 1)
'MasterCount = RowCounter
'MsgBox MasterArray(RowCounter, 1)


'DEBUG TEST
Debug.Print "Writing to array:" & MasterArray(MasterCount, 1) & MasterArray(MasterCount, 2)


 '   Summary.Cells(RowCounter, 1).Value = MasterArray(RowCounter, 1) & "dddd"
 '   Summary.Cells(RowCounter, 2).Value = MasterArray(RowCounter, 2) & "FFFF"
 '   RowCounter = RowCounter + 1


Next




'OPTION B:
'Worksheets("Sheet1").Range("A1").Resize(UBound(MasterArray, 1) + 1, UBound(MasterArray, 2) + 1).Value = MasterArray


'MsgBox TxnCounter & " RECORDS PROCESSED!" 'Pause during testing to check values


'====WRITE CALCULATED AMOUNTS TO CELLS====
'For x = 1 To MasterCount
 '   Debug.Print MasterArray(x, 1)
'Next


Sheets("Report").Range("c7").Value = CalcArray(11, 1)
Sheets("Report").Range("c8").Value = CalcArray(10, 1)
Sheets("Report").Range("c9").Value = CalcArray(9, 1)
Sheets("Report").Range("c10").Value = CalcArray(8, 1)
Sheets("Report").Range("c11").Value = CalcArray(7, 1)
Sheets("Report").Range("c12").Value = CalcArray(6, 1)
Sheets("Report").Range("c13").Value = CalcArray(5, 1)
Sheets("Report").Range("c14").Value = CalcArray(4, 1)
Sheets("Report").Range("c15").Value = CalcArray(3, 1)
Sheets("Report").Range("c16").Value = CalcArray(2, 1)


'====CLEAN UP====
'RESTORE APPLICATION STATE
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
'====CLEAN UP COMPLETED====
Worksheets("Sheet1").Activate
End Sub

Public Function IsInArray(MasterArray As Variant, UniqueKey As String) As Boolean
    Dim i As Integer, found As Boolean
    found = False


    If Not Len(Join(MasterArray)) > 0 Then
        found = False
    Else
        For i = 0 To UBound(MasterArray)
            If MasterArray(i) = UniqueKey Then
               found = True
            End If
        Next i
    End If
    IsInArray = found
End Function

 

[Beemerang]

I understand. I'm so deep into this with the code route, I'll just have to try and push through.

Thank you for all your help and advice and for taking the time to help a complete stranger. If I manage to get this working it will all be due to the help you gave me. Have a good week.

 

[Fluff]

Not sure if this will work, as I have nothing to test it on.

Sub Beemerang()
   Dim Ws As Worksheet
   Dim MasterArray As Variant, NewCustArray As Variant, RetainedCustArray As Variant, ShtAry As Variant
   Dim CustArray As Variant, x As Variant
   Dim i As Long
   Dim Dic As Object, dic2 As Object
   Dim RefCell As Range
   Dim UniqueKey As String
   Dim x As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   Set dic2 = CreateObject("scripting.dictionary")
   ShtAry = Array("Sep 2018", "Oct 2018", "Nov 2018", "Dec 2018", "Jan 2019", "Feb 2019", "Mar 2019")
'   ReDim NewCustArray(1 To UBound(ShtAry), 1 To 2)
   ReDim CustArray(1 To UBound(ShtAry), 1 To UBound(ShtAry) + 2)
   
   i = 0
   For Each Ws In ThisWorkbook.Worksheets
      If Ws.Name <> "Report" And Ws.Name <> "LTV" And Ws.Name <> "Master List" Then
         i = i + 1
         CustArray(i, 1) = Ws.Name
'         RetainedCustArray(i, 1) = Ws.Name
         For Each RefCell In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
            If RefCell.Offset(, 1).Value = "Settled Successfully" Then
               UniqueKey = RefCell.Offset(, 27).Value & RefCell.Offset(, 30).Value
               If Not Dic.Exists(UniqueKey) Then
                  x = Application.Match(Ws.Name, ShtAry, 0)
                  Dic.Add UniqueKey, x
                 CustArray(i, 2) = CustArray(i, 2) + 1
               ElseIf Not dic2.Exists(UniqueKey) Then
                  dic2.Add UniqueKey, Nothing
                  x = Dic.Item(UniqueKey)
                  CustArray(x, x + 2) = CustArray(x, x + 2) + 1
               End If
            End If
         Next RefCell
      End If
      dic2.RemoveAll
   Next Ws
   Sheets("Master List").Range("A2").Resize(12, UBound(CustArray, 2)).Value = CustArray
'   Sheets("Master List").Range("D1").Resize(12, 2).Value = RetainedCustArray
'   Sheets("Master List").Range("G1").Resize(Dic.Count, 2).Value = Application.Transpose(Array(Dic.Keys, Dic.Items))
End Sub

 

[Beemerang]

Fluff, I cannot express my appreciation enough that you are still spending time on this. Thank you a million times. I'm testing it now.

 

[Fluff]

Been having a bit of fun with this & whilst I'm not entirely sure what results you want, based on post#39
If you have the Master list set up like

Excel 2013/2016
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	New Customers		Repeat customers by month
2	Month	Count	Sep 2018	Oct 2018	Nov 2018	Dec 2018	Jan 2019	Feb 2019	Mar 2019	Apr 2019	May 2019	Jun 2019	Jul 2019	Aug 2019
3	Sep 2018
4	Oct 2018
5	Nov 2018
6	Dec 2018
7	Jan 2019
8	Feb 2019
9	Mar 2019
10	Apr 2019
11	May 2019
12	Jun 2019
13	Jul 2019
14	Aug 2019
Master List

Try this

Sub Beemerang()
   Dim Ws As Worksheet
   Dim MasterArray As Variant, NewCustArray As Variant, RetainedCustArray As Variant, ShtAry As Variant
   Dim CustArray As Variant, x As Variant
   Dim i As Long
   Dim Dic As Object, Dic2 As Object
   Dim RefCell As Range
   Dim UniqueKey As String
   
   Set Dic = CreateObject("scripting.dictionary")
   Set Dic2 = CreateObject("scripting.dictionary")
   With Sheets("Master List")
      .Range("A1").CurrentRegion.Offset(2, 1).ClearContents
      CustArray = .Range("A1").CurrentRegion.Value2
   End With
   
   For i = 3 To UBound(CustArray, 2)
      If Evaluate("isref('" & Format(CustArray(2, i), "mmm yyyy") & "'!A1)") Then
         Set Ws = Sheets(Format(CustArray(2, i), "mmm yyyy"))
         For Each RefCell In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
            If RefCell.Offset(, 1).Value = "Settled Successfully" Then
               UniqueKey = RefCell.Offset(, 27).Value & "|" & RefCell.Offset(, 30).Value
               If Not Dic.Exists(UniqueKey) Then
                  Dic.Add UniqueKey, i
                 CustArray(i, 2) = CustArray(i, 2) + 1
               ElseIf Not Dic2.Exists(UniqueKey) Then
                  Dic2.Add UniqueKey, Nothing
                  x = Dic.Item(UniqueKey)
                  CustArray(x, i) = CustArray(x, i) + 1
               End If
            End If
         Next RefCell
      End If
      Dic2.RemoveAll
   Next i
   Sheets("Master List").Range("A1").Resize(12, UBound(CustArray, 2)).Value = CustArray
End Sub

 

[Fluff]

Forgot to mention, the month names in Cl A & row 2 need to be proper dates.

 

[Beemerang]

Fluff, you are an absolute rockstar!!! Thank you! Will test this and let you know.

 

[Beemerang]

FLUFF, YOU ARE A GENIUS!!!! IT WORKS, THANK YOU SO MUCH!

Forgive the shouting but I'be been battling with this for a week and you nailed it so easily! Thank you!

 

[Fluff]

Glad to help & thanks for the feedback

 

[Beemerang]

Fluff, you're going to start thinking that this thread is The Neverending Story!

I tried to adapt your code to sum the transaction values for each month as well and past the result into a similar matrix as for the one you show above (located in cell A17 on my Master list sheet). Here is the code:

Sub BeemerangNew()   Dim Ws As Worksheet
   Dim MasterArray As Variant, NewCustArray As Variant, RetainedCustArray As Variant, ShtAry As Variant
   Dim CustArray As Variant, x As Variant, MRRArray As Variant
   Dim i As Long
   Dim Dic As Object, Dic2 As Object
   Dim RefCell As Range
   Dim UniqueKey As String
   
   Set Dic = CreateObject("scripting.dictionary")
   Set Dic2 = CreateObject("scripting.dictionary")
   With Sheets("Master List")
      .Range("A1").CurrentRegion.Offset(2, 1).ClearContents
      CustArray = .Range("A1").CurrentRegion.Value2
      .Range("A17").CurrentRegion.Offset(2, 1).ClearContents
      MRRArray = .Range("A17").CurrentRegion.Value2
   End With
   
   For i = 3 To UBound(CustArray, 2)
      If Evaluate("isref('" & Format(CustArray(2, i), "mmm yyyy") & "'!A1)") Then
         Set Ws = Sheets(Format(CustArray(2, i), "mmm yyyy"))
         For Each RefCell In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
            If RefCell.Offset(, 1).Value = "Settled Successfully" Then
               UniqueKey = RefCell.Offset(, 27).Value & "|" & RefCell.Offset(, 30).Value
               If Not Dic.Exists(UniqueKey) Then
                  Dic.Add UniqueKey, i
                 CustArray(i, 2) = CustArray(i, 2) + 1
                 MRRArray(i, 2) = MRRArray(i, 2) + RefCell.Offset(, 2).Value
               ElseIf Not Dic2.Exists(UniqueKey) Then
                  Dic2.Add UniqueKey, Nothing
                  x = Dic.Item(UniqueKey)
                  CustArray(x, i) = CustArray(x, i) + 1
                  MRRArray(i, 2) = MRRArray(i, 2) + RefCell.Offset(, 2).Value
               End If
            End If
         Next RefCell
      End If
      Dic2.RemoveAll
   Next i
   Sheets("Master List").Range("A1").Resize(12, UBound(CustArray, 2)).Value = CustArray
   Sheets("Master List").Range("A1").Resize(12, UBound(CustArray, 2)).Value = MRRArray
End Sub

However, I get a runtime 13 error type mismatch error on this line:

MRRArray(i, 2) = MRRArray(i, 2) + RefCell.Offset(, 2).Value

After some reading it seems that this is a data type assignment error (I initially thought that it was because I didn't redim the MRRArray but since you didn't I'm assuming I wouldn't need to either?)

I've tried experimenting but I also don't want to break the code you provided. Could you perhaps give me some final guidance?

Much obliged.

 

[Fluff]

Do you have values in column A from row A17 downwards & in row 17 from A17 across?
Also check that the values in col C of the month sheets are numbers, rather than text