Resizing an array dynamically

[Rhodie72]

I currently have this code which is giving me an headache. I can't remember how to resize the array in VBA dynamically. Would appreciate any help in this regard please.

ReDim Preserve Directories(0 To UBound(Directories(n)))

It's part of a series of loops and the n increments sequentially to the next highest number.

I can see this is going to be one of Homer's "Doh!" moments when the answer comes, but it's late and I'm tired.

I do need to preserve the data already stored in the array for future use too.

 

[Rhodie72]

Re: Need help pls -Resiszing an array dynamically

Might be a good idea as it's not to clear how you want to change the dimensions of the array.

In particular the use of UBound(Directories) seems a bit odd, to me anyway, but could be perfectly valid.

Here's the complete code. The ppurpose is to create strings that represent directories and then this information is passed onto another routine that creates the arrayed dimensions whilst checking each of them individually to see they don't already exist. I may actually split this up into seveeral functions because some of the features will be reused elsewhere.

Sub FileStructure()
    Dim Setting As String, BusinessName As String, myYear As Integer ', Setting As String
    Dim A As String, B(), C(), D(), Directories As Variant, n, j, k, ps As String

    ps = Application.PathSeparator

'\\ File structure design for the whole system \\

'#File structure# _
    Each workbook will contain a type of ledger _
    that cotains the accounts for that group. _

'#Drive or partition# C: _
    system path for the accounting system to work# _
#filing system and workbook structure# _
A: \FWBAS Accounts _
B:       \System _
C:              \Updates _
B:       \BusinessName\AccYear _
C:                          \Real _
D:                               \Debtors _
                                            \Business.xlsx _
                                            \Individual.xlsx _
D:                               \Creditors _
                                            \Business.xlsx _
                                            \Individual.xlsx _
C:                          \Paper _
D:                               \Real _
                                            \Fixed Assets.xlsx _
D:                               \General Ledger _
                                            \Assets.xlsx _
                                            \Income.xlsx _
                                            \Capital.xlsx

'\\ Installer drive path choice.
A = Setting & ps & "FWBAS Accounts"
B = Array("System", "BusinessName")
C = Array("Real", "Paper")
D = Array("Debtors", "Creditors", "Real", "General Ledger")
    
'\\ We can change this to a FORM later on.
    Setting = GetSetting(A, B(0), "Drv")
    If Setting = "" Then
        SaveSetting A, B(0), "Drv", InputBox("What Drive do you want to install system on?", A, "C:")
        GoSub DrvCheck
    End If

        'Saves installation drive in registry
Rem Start here
        'MkDir Setting & ps & A & ps
        'MkDir Setting ' and system path for the accounting system to work# "
    '    #Installation and system files & updates and

        For n = LBound(B) To UBound(B)
            Select Case n
            Case 1
            ' Add company name to folder design
                ReDim Preserve Directories(0 To n)
                Directories(n) = Directories(n) & ps & myYear
                Debug.Print Directories(n)

                For j = LBound(C) To UBound(C)
                    Select Case j
                    Case 0: GoSub C_Folders
                    Case Else
                        GoSub C_Folders
                        'create all the d folders
                        For k = LBound(D) To UBound(D)
                            GoSub D_Folders
                        Next k
                    End Select
                Next j

            Case 0
                GoSub B_Folders
            End Select
        Next n

Exit Sub
DrvCheck:
    Setting = GetSetting(A, B(0), "Drv")
    Return

B_Folders:
    ReDim Preserve Directories(0 To UBound(Directories(n)))
    Directories(n) = A & ps & B(n)
    Debug.Print Directories(n) & vbCrLf
    Return

C_Folders:
    ReDim Preserve Directories(n + j + 1)
    Directories(n + j) = A & ps & B(n) & C(j)
    Debug.Print Directories(n + j) & vbCrLf
    Return

D_Folders:
    ReDim Preserve Directories(n + j + k + 1)
    Directories(n + j + k) = A & ps & B(n) & C(j) & D(k)
    Debug.Print Directories(n + j + k) & vbCrLf
    Return
End Sub

 

[Rhodie72]

Re: Need help pls -Resiszing an array dynamically

No, that's a one-dimensional array. You resize it on every cycle of the loop:
n=0 --> ReDim Preserve Directories(0 To 0) --> it has 1 element;
n=1 --> ReDim Preserve Directories(0 To 1) --> it has 2 elements;
n=2 --> ReDim Preserve Directories(0 To 2) --> it has 3 elements, and so on.

Well that's what I thought but it reset the contents to 0. Very confusing. The full code is posted above, but here is where it's giving me grief:

Sub FileStructure()
    Dim Setting As String, BusinessName As String, myYear As Integer ', Setting As String
    Dim A As String, B(), C(), D(), Directories As Variant, n, j, k, ps As String

    ps = Application.PathSeparator

'\\ File structure design for the whole system \\

'#File structure# _
    Each workbook will contain a type of ledger _
    that cotains the accounts for that group. _

'#Drive or partition# C: _
    system path for the accounting system to work# _
#filing system and workbook structure# _
A: \FWBAS Accounts _
B:       \System _
C:              \Updates _
B:       \BusinessName\AccYear _
C:                          \Real _
D:                               \Debtors _
                                            \Business.xlsx _
                                            \Individual.xlsx _
D:                               \Creditors _
                                            \Business.xlsx _
                                            \Individual.xlsx _
C:                          \Paper _
D:                               \Real _
                                            \Fixed Assets.xlsx _
D:                               \General Ledger _
                                            \Assets.xlsx _
                                            \Income.xlsx _
                                            \Capital.xlsx

'\\ Installer drive path choice.
A = Setting & ps & "FWBAS Accounts"
B = Array("System", "BusinessName")
C = Array("Real", "Paper")
D = Array("Debtors", "Creditors", "Real", "General Ledger")
    
'\\ We can change this to a FORM later on.
    Setting = GetSetting(A, B(0), "Drv")
    If Setting = "" Then
        SaveSetting A, B(0), "Drv", InputBox("What Drive do you want to install system on?", A, "C:")
        GoSub DrvCheck
    End If

        'Saves installation drive in registry
Rem Start here
        'MkDir Setting & ps & A & ps
        'MkDir Setting ' and system path for the accounting system to work# "
    '    #Installation and system files & updates and

        For n = LBound(B) To UBound(B)
            Select Case n
            Case 1
            ' Add company name to folder design
'[COLOR=#008000]This seems to be ok except the data stored is reset to 0: frustrating[/COLOR]
                [COLOR=#ff0000][B]ReDim Preserve Directories(0 To n)[/B][/COLOR]
                Directories(n) = Directories(n) & ps & myYear
                Debug.Print Directories(n)

                For j = LBound(C) To UBound(C)
                    Select Case j
                    Case 0: GoSub C_Folders
                    Case Else
                        GoSub C_Folders
                        'create all the d folders
                        For k = LBound(D) To UBound(D)
                            GoSub D_Folders
                        Next k
                    End Select
                Next j

            Case 0
                GoSub B_Folders
            End Select
        Next n

Exit Sub
DrvCheck:
    Setting = GetSetting(A, B(0), "Drv")
    Return

B_Folders:
[COLOR=#008000][B]'This is where the error crops up.[/B] Runtime error 13: Type mismatch[/COLOR]
    [COLOR=#b22222][B]ReDim Preserve Directories(0 To UBound(Directories(n)))[/B][/COLOR]
    Directories(n) = A & ps & B(n)
    Debug.Print Directories(n) & vbCrLf
    Return

C_Folders:
    ReDim Preserve Directories(n + j + 1)
    Directories(n + j) = A & ps & B(n) & C(j)
    Debug.Print Directories(n + j) & vbCrLf
    Return

D_Folders:
    ReDim Preserve Directories(n + j + k + 1)
    Directories(n + j + k) = A & ps & B(n) & C(j) & D(k)
    Debug.Print Directories(n + j + k) & vbCrLf
    Return
End Sub

 

[RoryA]

Re: Need help pls -Resiszing an array dynamically

Ah GoSub, there's a blast from the past!

When you run the line that errors, n = 0 and there is nothing in your array. Therefore trying to get the UBound of a non-existent item will fail. There is no need to Preserve:

ReDim Directories(0 To 0)

 

[Rhodie72]

Re: Need help pls -Resiszing an array dynamically

Ah GoSub, there's a blast from the past!

When you run the line that errors, n = 0 and there is nothing in your array. Therefore trying to get the UBound of a non-existent item will fail. There is no need to Preserve:

ReDim Directories(0 To 0)

Ok, thanks. Iwill add an error management routine in there to avoid it in the future.

 

[Rhodie72]

Re: Need help pls -Resiszing an array dynamically

Now I have another error! OMG. I want to pack this up.

Subscript out of range:

B_Folders:
    If n > 0 Then ReDim Preserve Directories(0 To UBound(Directories(n)))
   [COLOR=#ff0000][B] Directories(n) = A & ps & B(n)[/B][/COLOR]
    Debug.Print Directories(n) & vbCrLf
    Return

 

[RoryA]

Re: Need help pls -Resiszing an array dynamically

As I said, the line above that should read:

ReDim Directories(0 To 0)

since n = 0.

 

[Rhodie72]

Re: Need help pls -Resiszing an array dynamically

Thanks Rory, you're right. Now I can move forward and complete it. I didn't quite understand what you meant exactly but here it is:

B_Folders:
    If n > 0 Then
        ReDim Preserve Directories(0 To UBound(Directories(n)))
    Else
        ReDim Directories(0 To 0)
        Directories(n) = A & ps & B(n)
    End If
    Debug.Print Directories(n) & vbCrLf
    Return

 

[Rhodie72]

Re: Need help pls -Resiszing an array dynamically

Thank you everyone for your help. Here is the final working code:

Sub FileStructure()
    Dim Setting As String, BusinessName As String, myYear As Integer ', Setting As String
    Dim A As String, B(), C(), D(), Directories(), n As Byte, j, k, ps As String, MyString As String

    ps = Application.PathSeparator

'\\ Installer drive path choice.
A = Setting & ps & "FWBAS Accounts"
B = Array("System", "BusinessName")
C = Array("Real", "Paper")
D = Array("Debtors", "Creditors", "Real", "General Ledger")
    
'\\ We can change this to a FORM later on.
    Setting = GetSetting(A, B(0), "Drv")
    If Setting = "" Then
        SaveSetting A, B(0), "Drv", InputBox("What Drive do you want to install system on?", A, "C:")
        GoSub DrvCheck
    End If
A = Setting & ps & "FWBAS Accounts"

        'Saves installation drive in registry
Rem Start here
        'MkDir Setting & ps & A & ps
        'MkDir Setting ' and system path for the accounting system to work# "
    '    #Installation and system files & updates and

        For n = LBound(B) To UBound(B)
            If n > 0 Then
                GoSub B_Folders
            ' Add company name to folder design
                For j = LBound(C) To UBound(C)
                    Select Case j
                    Case 0: GoSub C_Folders
                    Case Else
                        GoSub C_Folders
                        'create all the d folders
                        For k = LBound(D) To UBound(D)
                            GoSub D_Folders
                        Next k
                    End Select
                Next j
            Else
                GoSub B_Folders
            End If
        Next n
    Erase Directories, B, C, D
Exit Sub
DrvCheck:
    Setting = GetSetting(A, B(0), "Drv")
    Return

B_Folders:
    If n > 0 Then
        ReDim Preserve Directories(0 To n)
    Else
        ReDim Directories(0 To 0)
    End If
    Directories(n) = A & ps & B(n)
    Debug.Print Directories(n)
    Return

C_Folders:
    ReDim Preserve Directories(n + j + 1)
    Directories(n + j) = A & ps & B(n) & ps & myYear & ps & C(j)
    Debug.Print Directories(n + j)
    Return

D_Folders:
    ReDim Preserve Directories(n + j + k + 1)
    Directories(n + j + k) = A & ps & B(n) & ps & myYear & ps & C(j) & ps & D(k)
    Debug.Print Directories(n + j + k)
    Return
End Sub

 

[RoryA]

Re: Need help pls -Resiszing an array dynamically

You only run B_Folders if n = 0 so there is no point to that additional check. Even if there were, you'd just resize to n, not to Ubound(Dimensions)

 

[Rhodie72]

Re: Need help pls -Resiszing an array dynamically

You only run B_Folders if n = 0 so there is no point to that additional check. Even if there were, you'd just resize to n, not to Ubound(Dimensions)

That's exactly what I figured. It's working now which is what matters. Later on as I finish the system, I will recover code to the best format and the least amount of code.