New to arrays - Array not returning values

Beemerang

Board Regular
Joined
Sep 14, 2011
Messages
114
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!

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
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
I have no idea what your code is trying to do, but a few observations.
Here
Code:
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
Code:
[COLOR=#ff0000]Sheets(SheetCounter)[/COLOR].Name
inside the loop will need to be changed to
Code:
[COLOR=#ff0000]Sheet[/COLOR].Name
although I would advise using keywords as names of variables.
Here
Code:
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
Code:
                   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
Code:
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.
 
Last edited:
Upvote 0
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.
 
Upvote 0
If you are simply trying to update the list of Unique Ids, try
Code:
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
 
Upvote 0
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.
 
Upvote 0
Ok,how about
Code:
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
 
Upvote 0
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!!
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
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"?
 
Upvote 0
Try
Code:
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.
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,198
Members
448,554
Latest member
Gleisner2

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
Back
Top