how to assign values to arrays using loop

Question

I want to assign values to arrays from a sheet using loop

I tried using this but gives error "Subscript out of Range"

 i=1
 With ws
        Do While i <= 40
            ReDim Preserve WorkID(1 To i)
            ReDim Preserve Work(1 To i)
            ReDim Preserve ComposerName(1 To i)

            WorkID(i) = Range("A" & i + 1).Value
            Work(i) = Range("B" & i + 1).Value
            ComposerName(i) = Range("C" & i + 1).Value
        i = i + 1
        Loop
    End With

I tried both ways to initialize but none of them worked

Initialize Type 1

Dim WorkID() As Variant              
Dim Work() As Variant                
Dim ComposerName() As Variant

Initialize Type 2

Dim WorkID(1 to 40) As Variant              
Dim Work(1 to 40) As Variant                
Dim ComposerName(1 to 40) As Variant

Also I tried without Redim as well like this but nothing worked:

   i=1
   With ws
        Do While i <= 40
            WorkID(i) = Range("A" & i + 1).Value
            Work(i) = Range("B" & i + 1).Value
            ComposerName(i) = Range("C" & i + 1).Value
        i = i + 1
        Loop
    End With

Full Sub here :

Option Explicit
Sub Join()

Dim WorkID()             'Stores the workID from Works Sheet
Dim Work()                 'Stores the work from Works Sheet
Dim ComposerName()       'Stores the composer from Works Sheet
Dim ConductorID()          'Stores the ConductorID from Conductors Sheet
Dim ConductorNames()       'Stores Conductor Names from Conductors Sheet
Dim CDWorkID()           'Stores CDWorkID  from CD Sheet
Dim CDCondID()                 'Stores CDConductor ID  from CD Sheet

Dim i, j, k, m As Long
Dim ws, wcon, wcd, wj As Worksheet

Set ws = Sheets("Works")
Set wcon = Sheets("Conductors")
Set wcd = Sheets("CDs")
Set wj = Sheets("Join")

i = j = k = 1                                   'Initalize

ws.Activate

        Do While i <= 40
            ReDim Preserve WorkID(1 To i)
            ReDim Preserve Work(1 To i)
            ReDim Preserve ComposerName(1 To i)

            WorkID(i) = Range("A" & i + 1).Value
            Work(i) = Range("B" & i + 1).Value
            ComposerName(i) = Range("C" & i + 1).Value
        i = i + 1
        Loop

wcon.Activate
        Do While j <= 10
            ReDim Preserve ConductorID(1 To j)
            ReDim Preserve ConductorNames(1 To j)
            ConductorID(j) = Range("A" & j + 1).Value
            ConductorNames(j) = Range("B" & j + 1).Value
            j = j + 1
        Loop

wcd.Activate

        Do While k <= 132
            ReDim Preserve CDWorkID(1 To k)
            ReDim Preserve CDCondID(1 To k)
            CDWorkID(k) = Range("A" & k + 1).Value
            CDCondID(k) = Range("B" * k + 1).Value
        k = k + 1
        Loop

wj.Activate    
        For i = LBound(CDWorkID) To UBound(CDWorkID)
        Range("F" & i) = CDWorkID(i)
        Next i

End Sub

Answer 1

Range("B" * k + 1).Value has a typo - you meant Range("B" & k + 1).Value. This makes the range raise an "type" error. Eliminating this makes the code run without error - I suspect the error message is incorrect.

BTW, there is another pitfall (which does not lead to a runtime error, at least not for the code shown):
Dim i, j, k, m As Long Dim ws, wcon, wcd, wj As Worksheet
will NOT declare i, j, kas Integer but as Variants. Same for ws, wcon, wcd which are variants and NOT worksheet objects.

Answer 2

RedDim Preserve is generally an expensive operation since it involves allocating space for a larger array and moving contents from the old array. It is almost always a bad idea to use it inside of a loop. Instead -- determine ahead of time how big the arrays need to be and ReDim just once. If you don't know ahead of time, make them larger than needed and then use a ReDim Preserve after the loop to trim them down to size. In your case, I would Redim the arrays before entering for loops (or even -- why not Dim them the right size to begin with?). Also -- prefix each range with the appropriate worksheet variable rather than activating each in turn. Something like:

Sub Join()

Dim WorkID()             'Stores the workID from Works Sheet
Dim Work()                 'Stores the work from Works Sheet
Dim ComposerName()       'Stores the composer from Works Sheet
Dim ConductorID()          'Stores the ConductorID from Conductors Sheet
Dim ConductorNames()       'Stores Conductor Names from Conductors Sheet
Dim CDWorkID()           'Stores CDWorkID  from CD Sheet
Dim CDCondID()                 'Stores CDConductor ID  from CD Sheet

Dim i As Long
Dim ws, wcon, wcd, wj As Worksheet

Set ws = Sheets("Works")
Set wcon = Sheets("Conductors")
Set wcd = Sheets("CDs")
Set wj = Sheets("Join")

ReDim WorkID(1 To 40)
ReDim Work(1 To 40)
ReDim ComposerName(1 To 40)
For i = 1 To 40
    WorkID(i) = ws.Range("A" & i + 1).Value
    Work(i) = ws.Range("B" & i + 1).Value
    ComposerName(i) = ws.Range("C" & i + 1).Value
Next i

ReDim ConductorID(1 To 10)
ReDim ConductorNames(1 To 10)
For i = 1 To 10
    ConductorID(i) = wcon.Range("A" & i + 1).Value
    ConductorNames(i) = wcon.Range("B" & i + 1).Value
Next i

ReDim CDWorkID(1 To 132)
ReDim CDCondID(1 To 132)
For i = 1 To 132
    CDWorkID(k) = wcd.Range("A" & i + 1).Value
    CDCondID(k) = wcd.Range("B" & i + 1).Value
Next i

For i = LBound(CDWorkID) To UBound(CDWorkID)
    wj.Range("F" & i) = CDWorkID(i)
Next i

End Sub