Sturped
Sturped

Reputation: 33

VBA array trouble error 9 script out of range

Thanks for reading my question,

I was given a list of about 250k entries along with names and sign in dates to accompany each entry to show when they logged. My task is to find out which users signed in on consecutive days, how often and how many times.

i.e. Bob smith had 3 consecutive days one time, 5 consecutive days 3 times. joe smith had 8 consecutive days once, 5 consecutive days 8 times etc

I am brand new to VBA and have been struggling to write a program to do this. code:

Option Explicit

Option Base 1

Sub CountUUIDLoop()

    Dim UUID As String
    Dim Day As Date
    Dim Instance() As Variant
    ReDim Instance(50, 50)
    Dim CountUUID As Variant
    Dim q As Integer
    Dim i As Long
    Dim j As Long
    Dim f As Integer
    Dim g As Integer
    Dim LastRow As String
    f = 1
    q = 1
    g = 2

        LastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
        For i = q To LastRow
            UUID = Cells(i, "A")
            Instance(f, 1) = UUID

            g = 2
            For j = 1 To LastRow
                If UUID = Cells(j, "A") Then
                    Instance(f, g) = Cells(j, "B")
                    g = g + 1
                End If

            Next j
            f = f + 1
            q = g - 1
        Next i

End Sub

The goal of this code is to go through the entries and store them in the array 'Instance' such that the 2D array would look like [UUID1, B1, B2, B3] [UUID2, B1, B2, B3, B4] [UUID3, B1, B2]

Where the UUID is the user, the B1 represents the date that user signed in, b2 would be the next date they signed in etc. Some users have more or less dates than others.

My main issue has come with setting up the array as I keep getting different errors around it. I'm not sure how to define this 2D array partly because there will be over 30 000 rows, each with 1->85 columns.

Any help is appreciated, let me know if anything needs further clarification. Once again this is my first time using VBA so im sorry ahead of time if everything i've been doing is wrong.

P.S. I used ReDim Instance (50,50) as a test to see if i could make it work by predefining but same errors occurred. Thanks again!

Upvotes: 3

Views: 1164

Answers (3)

TooroSan
TooroSan

Reputation: 162

As far as I understand from your question and code, you have a table with following structure:

..............A.................B
1........LOGIN1.......DATE1
2........LOGIN1.......DATE2
3........LOGIN1.......DATE3
4........LOGIN2.......DATE4
5........LOGIN2.......DATE5
6........LOGIN3.......DATE6

And your task in this code was to fetch data in a 2D structure like this:
RESULT_ARRAY-
............................|-LOGIN1-
............................................|-DATE1
............................................|-DATE2
............................................|-DATE3
............................|-LOGIN2-
............................................|-DATE4
............................................|-DATE5
............................|-LOGIN3-
............................................|-DATE6

First of all, you need to know what goes wrong in your code. Please see comments in code below to find out the reason of error:

Option Explicit

Option Base 1

Sub CountUUIDLoop()

    Dim UUID As String
    Dim Day As Date
    Dim Instance() As Variant ' If you are using variant data type, it is not necesary to point it: default data type in VBA is Variant. Just write like this: "Dim Instance()"
    ReDim Instance(50, 50) ' Limitation in 50 may be the reason, why your script is going into "out of range" error.
                           ' Remember, that this operation means, that your array now will have following dimentions: [1..50,1..50]
    Dim CountUUID As Variant 'Just write like this: "Dim CountUUID"
    Dim q As Integer ' you can describe all your variables in one line, like this: "Dim q as Integer,f as Integer,g as Integer"
    Dim i As Long
    Dim j As Long
    Dim f As Integer
    Dim g As Integer
    Dim LastRow As String ' first mistake: you are using String data type to perform numeric operations below in your FOR-cycle
    f = 1 ' Your Instance array index starts from {0} and you are not using this index by starting from {1}.
    q = 1 ' The reason to use this variable is not obvious. You could just use constant in FOR cycle below and avoid unnecessary variables.
    g = 2 ' You could remove this line, because this var is set every time in cycle below (before second FOR)

        LastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row ' The alternative here is to use predefined Excel constants, like this:
                                                                      ' "Cells.SpecialCells(xlLastCell).Row".
        'If LastRow is bigger, than {50} - this could be a reason of your Error.
        For i = q To LastRow  ' Here goes comparison between String and Integer data type, not good thing, but type conversion should work fine here.
            UUID = Cells(i, "A") ' No need to perform re-set here, just move forward and assign value from this cell to the Instanse directly:
                                 ' Like this: Instance(f, 1) = Cells(i, "A")
            Instance(f, 1) = UUID

            g = 2
            For j = 1 To LastRow ' It is another point, why "q" variable is not necessary. :)
                If UUID = Cells(j, "A") Then ' You could use your Instansce value instead of UUID there, like this: "Instance(f, 1)"
                    Instance(f, g) = Cells(j, "B") 'If "g" variable will somehow become bigger, than {49}, this could become a reason of your Error.
                    g = g + 1
                End If

            Next j
            f = f + 1
            q = g - 1 ' "q" variable is not used after this row, so it is a strange unnecessary action
        Next i

End Sub

Now, when we have some information about error, let me do some improvements on your code. I am certain, that to make most simply code, you can use your Excel worksheets to store and count data with VBA as background automations. But if you need the code with arrays, let's do this! :)

Option Explicit ' It is an option that turns on check for every used variable to be defined before execution. If this option is not defined, your code below will find undefined variables and define them when they are used. Good practice is to use this option, because it helps you, for example to prevent missprinting errors in variable names.

Option Base 1 ' This option sets the default index value for arrays in your code. If this option is not set, the default index value will be {0}.

Const HEADER_ROW = 1 ' It is a number to identify your header row, next row after this one will be counted as a row with data
Const UUID = 1 ' ID of element in our "Instance" array to store UUID
Const DATES_ID = 2 ' ID of element in our "Instance" array to store dates

Function CountUUIDLoop()
    ActiveSheet.Copy After:=ActiveSheet 'Copy your worksheet to new one to ensure that source data will not be affected.
    Dim Instance(), dates() ' "Instance" will be used to store all the data, "dates" will be used to store and operate with dates
    ReDim Instance(2, 1) ' Set first limitation to the "Instance" array in style [[uuid, dates],id]
    ReDim dates(1) ' Set first limitation to the "dates" array
    Instance(DATES_ID, 1) = dates
    Dim CountUUID
    Dim i as Long, j as Long, f as Long, active_element_id As Long 'Integer is quite enough to perform our array manipulations, but Long datatype is recomended (please refer to UPDATE2 below)
    i = HEADER_ROW + 1 ' Set first row to fetch data from the table
    active_element_id = 1 ' Set first active element number
    With ActiveSheet ' Ensure that we are working on active worksheet.
        While .Cells(i, 1) <> "" 'If operated cell is not empty - continue search for data
            If i > HEADER_ROW + 1 Then
                active_element_id = active_element_id + 1 ' increment active element number
                ReDim Preserve Instance(2, active_element_id) ' Assign new limitation (+ 1) for our Instances, don't forget to preserve our results.
                ReDim dates(1) ' Set first limitation to the "dates" array
                Instance(DATES_ID, active_element_id) = dates
            End If
            Instance(UUID, active_element_id) = .Cells(i, 1) ' save UUID
            dates(1) = .Cells(i, 2) ' save first date
            j = i + 1 ' Set row to search next date from as next row from current one.
            While .Cells(j, 1) <> "" 'If operated cell is not empty - continue search for data
                If .Cells(j, 1) = .Cells(i, 1) Then
                    ReDim Preserve dates(UBound(dates) + 1) ' Expand "dates" array, if new date is found.
                    dates(UBound(dates)) = .Cells(j, 2) ' Save new date value.
                    .Cells(j, 1).EntireRow.Delete 'Remove row with found date to exclude double checking in future
                Else
                    j = j + 1 ' If uuid is not found, try next row
                End If
            Wend
            Instance(DATES_ID, active_element_id) = dates
            i = i + 1 'After all the dates are found, go to the next uuid
        Wend
        .Cells(i, 1) = "UUID COUNT" ' This will write you a "UUID COUNT" text in A column below all the rest of UUIDs on active worksheet
        .Cells(i, 2) = i - HEADER_ROW - 1 ' This will write you a count of UUIDs in B column below all the rest of UUIDs on active worksheet
    End With
    CountUUIDLoop = Instance ' This ensures that your function (!) returns an array with all UUIDs and dates inside.
End Function

This function will print you count of your UUIDs at the bottom of active sheet and return you an array like this: [[LOGIN1][1], [[DATE1][DATE2][DATE3]][1]]

I have used this order of storing data to avoid error with expanding of multidimentional arrays. This error is similar to yours, so you could read more about this there:
How can I "ReDim Preserve" a 2D Array in Excel 2007 VBA so that I can add rows, not columns, to the array?
Excel VBA - How to Redim a 2D array?
ReDim Preserve to a Multi-Dimensional Array in Visual Basic 6

Anyway, you could use my function output ("Instance" array) to perform your further actions to find what you need or even display your uuid-dates values. :)

Good luck in your further VBA actions!

UPDATE

Here is the test procedure showing how to work with the above function's results:

Sub test()
 Dim UUIDs ' The result of the "CountUUIDLoop" function will be stored there
 Dim i as Long, j As Long ' Simple numeric variables used as indexies to run through our resulting array
 UUIDs = CountUUIDLoop ' assign function result to a new variable
 Application.DisplayAlerts = False ' Disable alerts from Excel
 ActiveSheet.Delete ' Delete TMP worksheet
 Application.DisplayAlerts = True ' Enable alerts from Excel
 If UUIDs(UUID, 1) <> Empty Then ' This ensures that UUIDs array is not empty
    Sheets.Add After:=ActiveSheet ' Add new worksheet after active one to put data into it
    With ActiveSheet 'Ensure that we are working with active worksheet
        .Cells(HEADER_ROW, 1) = "UUIDs/dates" ' Put the header into the "HEADER_ROW" row
        For i = 1 To UBound(UUIDs, 2) ' run through all the UUIDs
           .Cells(1 + HEADER_ROW, i) = UUIDs(UUID, i) ' Put UUID under the header
           For j = 1 To UBound(UUIDs(DATES_ID, i)) ' run through all the dates per UUID
             .Cells(j + 1 + HEADER_ROW, i) = UUIDs(DATES_ID, i)(j) ' put date into column below the UUID
           Next j ' Go to next date
        Next i ' Go to next UUID
        .Cells.EntireColumn.AutoFit ' This will make all columns' width to fit its contents
    End With
 Else
    MsgBox "No UUIDs are found!", vbCritical, "No UUIDs on worksheet" ' Show message box if there are no UUIDs in function result
 End If
End Sub

So, if you'll have following data on the active worksheet:
..............A.................B
1........LOGIN1.......DATE1
2........LOGIN1.......DATE2
3........LOGIN1.......DATE3
4........LOGIN2.......DATE4
5........LOGIN2.......DATE5
6........LOGIN3.......DATE6
...this sub will put UUIDs on the new sheet like this:
..............A.................B.................C
1........UUIDs/dates
2........LOGIN1........LOGIN2........LOGIN3
3........DATE1.........DATE4.........DATE6
4........DATE2.........DATE5
5........DATE3

UPDATE2
It is recomended to use Long data type instead of Integer each type when integer (or whole number) variable is needed. Long is slightly faster, it has much wider limitations and costs no additional memory. Here is proof link:
MSDN:The Integer, Long, and Byte Data Types

Upvotes: 1

Frank
Frank

Reputation: 454

I would recommend using collections and a dictionary instead of arrays. The below code will structure the data in a way that is very similar to the way you wanted it.

Sub collect_logins_by_user_()
    'you need to enable the microsoft scripting runtime
    'in tools - references
    'assuming unique ids are in col A and there are no gaps
    'and assuming dates in col B and there are no gaps
    '
    'The expected runtime for this is O(n) and I have used similar code on more than 250.000 record.
    'It still takes a while obviously, but should run just fine.
    '
    'The the data will bestructed in the following format:
    '{id_1: [d_1, d_2,...], id_2: [d_3, d_4,...], ...}

    Dim current_id As Range: Set current_id = ActiveSheet.Range("A2") 'modify range as required
    Dim logins_by_users As New Dictionary
    While Not IsEmpty(current_id)

        If Not logins_by_users.Exists(current_id.Value) Then
            Set logins_by_users(current_id.Value) = New Collection
        End If
        logins_by_users(current_id.Value).Add current_id.Offset(ColumnOffset:=1).Value
        Set current_id = current_id.Offset(RowOffset:=1)
    Wend

    'Once you have the data structured, you can do whatever you want with it.
    'like printing it to the immediate window.

    Dim id_ As Variant
    For Each id_ In logins_by_users
        Debug.Print "======================================================="
        Debug.Print id_
        Dim d As Variant
        For Each d In logins_by_users(id_)
            Debug.Print d
        Next d
    Next id_
    Debug.Print "======================================================="
End Sub

Upvotes: 1

IAmDranged
IAmDranged

Reputation: 3020

I have written a bit of code that does something along the lines of what you are trying to do - it prints to the debug window the different numbers of consecutive logs per user, separeted by commas.

This code makes use of the dictionary object - which essentially is an associative array where the indexes are not restrained to numbers like they are in arrays, and offers a couple of convenient features to manipulate data that arrays don't.

I have tested this on a sheet including user ids in colomn A and log dates in column B - including headers - and this looks to work fine. Fell free to give it a try

Sub mysub()
    Dim dic As Object
    Dim logs As Variant
    Dim myval As Long
    Dim mykey As Variant
    Dim nb As Long
    Dim i As Long

    Set dic = CreateObject("Scripting.dictionary")

    'CHANGE TO YOUR SHEET REFERENCE HERE
    For Each cell In Range(Cells(2, 1), Cells(Worksheets("Sheet8").Rows.count, 1).End(xlUp))

        mykey = cell.Value
        myval = cell.Offset(0, 1)

        If myval <> 0 Then
            On Error GoTo ERREUR
            dic.Add mykey, myval
            On Error GoTo 0
        End If

    Next cell

    For Each Key In dic

        logs = Split(dic(Key), ",")

        logs = sortArray(logs)

        i = LBound(logs) + 1
        nb = 1

        Do While i <= UBound(logs)

            Do While CLng(logs(i)) = CLng(logs(i - 1)) + 1
                nb = nb + 1
                i = i + 1
            Loop

            If nb > 1 Then
                tot = tot & "," & CStr(nb)
                nb = 1
            End If

            i = i + 1

        Loop

        If tot <> "" Then dic(Key) = Right(tot, Len(tot) - 1)
        Debug.Print "User: " & Key & " - Consecutive logs: " & dic(Key)
        tot = ""
        mys = ""

    Next Key

    Exit Sub

ERREUR:

    If myval <> 0 Then dic(mykey) = dic(mykey) & "," & CStr(myval)
    Resume Next

End Sub


Function sortArray(a As Variant) As Variant
    For i = LBound(a) + 1 To UBound(a)
        j = i
        Do While a(j) < a(j - 1)
            temp = a(j - 1)
            a(j - 1) = a(j)
            a(j) = temp
            j = j - 1
            If j = 0 Then Exit Do
        Loop
    Next i
    sortArray = a
End Function

Upvotes: 0

Related Questions