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

 

[Fluff]

I have no idea what your code is trying to do, but a few observations.
Here

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)

You populate an array & then wipe it out with the 2nd of those two lines, so that array is empty. Although you don't seem to be using it anywhere.


You are also attempting to loop through all the sheets, but are in-fact only ever looking at the last sheet in the workbook.
So everywhere you have this part in red

[COLOR=#ff0000]Sheets(SheetCounter)[/COLOR].Name

inside the loop will need to be changed to

[COLOR=#ff0000]Sheet[/COLOR].Name

although I would advise using keywords as names of variables.
Here

KeyResult = IsInArray2DIndex(UniqueKey, MasterArray)

you are calling a function, but it is a different name to the function you have posted, so not sure if it's working or not.
On the first pass through the loop these two lines will overwrite the last value in your MasterArray

                   MasterArray(MasterCount, 1) = UniqueKey
                    MasterArray(MasterCount, 2) = MonthAdded

on each subsequent loop those line will fail, because you are incrementing MasterCount so it will be outside the limit of the array.

I would also STRONGLY recommend removing this line

On Error Resume Next

all it does is mask the errors, so that you have no way of knowing what is & what isn't working.

 

[Beemerang]

Hey Fluff

Thank you so much for taking the time to unravel my code and pointing out the mistakes. I really appreciate it tremendously! I am going to incorporate your feedback into my code and see if this puts me on the right path.

 

[Fluff]

If you are simply trying to update the list of Unique Ids, try

Sub Beemerang()
   Dim Ws As Worksheet
   Dim MstAry As Variant, ShtAry As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
   Dim Unq As String
   
   Set Dic = CreateObject("scripting.dictionary")
   Set ShtAry = Sheets(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"))
   
   With Sheets("Master List")
      MstAry = .Range("A1", .Range("B" & Rows.Count).End(xlUp)).Value2
   End With
   For i = 1 To UBound(MstAry)
      Dic.Item(MstAry(i, 1)) = MstAry(i, 2)
   Next i
   
   For Each Ws In ShtAry
      For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
         If Cl.Offset(, 1).Value = "Settled Successfully" Then
            Unq = Cl.Offset(, 27).Value & Cl.Offset(, 30).Value
            If Not Dic.Exists(Unq) Then Dic.Add Unq, Ws.Name
         End If
      Next Cl
   Next Ws
   Sheets("Sheet1").Range("A1").Resize(Dic.Count, 2).Value = Application.Transpose(Array(Dic.Keys, Dic.Items))
End Sub

 

[Beemerang]

Thank you so much for taking the trouble to provide me with some code, Fluff.

I'm actually attempting something that is above my skill level. I am trying to loop through several sheets with transactions and trying to count how many new customers appeared during a month (each has a unique customer ID) and how many customers made a repeat purchase in any given month so e.g. a customer purchased for the 1st time n Sep, then again in Dec. They would be counted a new customer in Sep and a retained customer in Dec. My struggle is to match their unique ID against transactions in each previous month in order to determine whether they should be counted as a new or retained customer.

My approach was to load all the unique IDs into an array and then test each transaction's ID against that array but, as you can see, I am failing miserably.

Thanks a million for your help though, I'll keep banging away at this until I can figure it out.

 

[Fluff]

Ok,how about

Sub Beemerang()
   Dim Ws As Worksheet
   Dim MstAry As Variant, ShtAry As Variant, NewAry As Variant, RetAry As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
   Dim Unq As String
   
   Set Dic = CreateObject("scripting.dictionary")
   Set ShtAry = Sheets(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 NewAry(1 To ShtAry.Count, 1 To 2)
   
   With Sheets("Master List")
      MstAry = .Range("A1", .Range("B" & Rows.Count).End(xlUp)).Value2
   End With
   For i = 1 To UBound(MstAry)
      Dic.Item(MstAry(i, 1)) = MstAry(i, 2)
   Next i
   
   i = 0
   For Each Ws In ShtAry
      i = i + 1
      NewAry(i, 1) = Ws.Name
      RetAry(i, 1) = Ws.Name
      For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
         If Cl.Offset(, 1).Value = "Settled Successfully" Then
            Unq = Cl.Offset(, 27).Value & Cl.Offset(, 30).Value
            If Not Dic.Exists(Unq) Then
               Dic.Add Unq, Ws.Name
               NewAry(i, 2) = NewAry(i, 2) + 1
            Else
               RetAry(i, 2) = RetAry(i, 2) + 1
            End If
         End If
      Next Cl
   Next Ws
   Sheets("Sheet1").Range("A1").Resize(12, 2).Value = NewAry
   Sheets("Sheet1").Range("D1").Resize(12, 2).Value = RetAry
End Sub

 

[Beemerang]

Wow mate, thanks a MILLION for your help!!

I'm going to try and slot your code into mine without breaking it.

You are a rock star, thanks again!!

 

[Fluff]

You're welcome & thanks for the feedback

 

[Beemerang]

Sorry Fluff, another question if I may:

Set ShtAry = Sheets(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"))

Would it be possible to populate this array with all sheets in the workbook EXCEPT for the sheets named "Report" and "LTV"?

 

[Fluff]

Try

Sub Beemerang()
   Dim Ws As Worksheet
   Dim MstAry As Variant, NewAry As Variant, RetAry As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
   Dim Unq As String
   
   Set Dic = CreateObject("scripting.dictionary")
   ReDim NewAry(1 To Sheets.Count, 1 To 2)
   
   With Sheets("Master List")
      MstAry = .Range("A1", .Range("B" & Rows.Count).End(xlUp)).Value2
   End With
   For i = 1 To UBound(MstAry)
      Dic.Item(MstAry(i, 1)) = MstAry(i, 2)
   Next i
   
   i = 0
   For Each Ws In Worksheets
      If Ws.Name <> "Report" And Ws.Name <> "LTV" And Ws.Name <> "Master List" Then
         i = i + 1
         NewAry(i, 1) = Ws.Name
         RetAry(i, 1) = Ws.Name
         For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
            If Cl.Offset(, 1).Value = "Settled Successfully" Then
               Unq = Cl.Offset(, 27).Value & Cl.Offset(, 30).Value
               If Not Dic.Exists(Unq) Then
                  Dic.Add Unq, Ws.Name
                  NewAry(i, 2) = NewAry(i, 2) + 1
               Else
                  RetAry(i, 2) = RetAry(i, 2) + 1
               End If
            End If
         Next Cl
      End If
   Next Ws
   Sheets("Sheet1").Range("A1").Resize(12, 2).Value = NewAry
   Sheets("Sheet1").Range("D1").Resize(12, 2).Value = RetAry
End Sub

I've assumed you don't want to run it on the master list as well.