Excel vba two dimensional array loop stops

Question

As part of a longer code I am trying to assign specific a staff name to each row based on an two dimensional alphabet assignment array. LastRow has been declared and picks up correctly but the loop still stops after 27 loops regardless. How can this be corrected to continue through to the LastRow? This is my first time working with multi-dimensional arrays so I greatly appreciate any assistance.

Private Sub Assignments()
    Dim Alpha As Variant, Staff As Variant
    Dim i As Integer
    Dim LastRow As Long
    Dim alpha_Assignment(1 To 26, 1 To 2) As Variant

    'define last row
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

    'set alpha column to array and set staff to array
    Alpha = Range("AB2:AB" & LastRow).Value
    Staff = Range("AC2:AC" & LastRow).Value

    'Array Values to Alpha and Assigned staff
    alpha_Assignment(1, 1) = "A"
    alpha_Assignment(1, 2) = "Staff 1"
    alpha_Assignment(2, 1) = "B"
    alpha_Assignment(2, 2) = "Staff 2"
    alpha_Assignment(3, 1) = "C"
    alpha_Assignment(3, 2) = "Staff 3"
    'and so on for all 26 letters in alphabet then loop statement and paste into worksheet.

    For i = 1 To UBound(alpha_Assignment)
        If Alpha(i, 1) = alpha_Assignment(i, 1) Then
            Staff(i, 1) = alpha_Assignment(i, 2)
        ElseIf Alpha(i, 1) <> alpha_Assignment(i, 1) Then
            Staff(i, 1) = "Staff 1"
        End If
    Next i

    Range("AC2").Resize(UBound(Staff, 1), 1).Value = Staff
End Sub

user3598756 · Accepted Answer · 2017-01-19 14:54:08Z

1

this "coupling" work seems to call for Dictionary object

like follows:

Option Explicit

Private Sub Assignments()
    Dim Alpha As Variant, Staff As Variant
    Dim i As Integer
    Dim LastRow As Long

    'define last row
    LastRow = Cells(Rows.count, "A").End(xlUp).Row

    'set alpha column to array and set staff to array
    Alpha = Range("AB2:AB" & LastRow).Value
    Staff = Range("AC2:AC" & LastRow).Value

    Dim alphaDict As Scripting.Dictionary

    Set alphaDict = New Scripting.Dictionary

    'dictionary with key=Alpha and Item=Assigned staff
    With alphaDict
        .Add "A", "Staff 1"
        .Add "B", "Staff 2"
        .Add "C", "Staff 3"
        .Add "D", "Staff 4"
        .Add "E", "Staff 5"
        .Add "F", "Staff 6"
        'and so on for all 26 letters in alphabet
    End With

    For i = 1 To UBound(Alpha)
        If alphaDict.Exists(Alpha(i, 1)) Then Staff(i, 1) = alphaDict(Alpha(i, 1))
    Next i

    Range("AC2").Resize(UBound(Staff, 1), 1).Value = Staff
End Sub

to use Dictionary object you have to add the necessary reference to your project as follows

click Tools-> References
scroll listbox down to "Microsoft Scripting Runtime" and tick its checkmark
click "OK"

edited Jan 19, 2017 at 14:54

answered Jan 19, 2017 at 14:21

user3598756

29.5k4 gold badges20 silver badges30 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

J.T. Over a year ago

Ok I've enabled the scripting runtime but receive run-time error 438 object doesn't support this property or method. I've never tried dictionary before so am really unfamiliar with this process.

user3598756 Over a year ago

Sorry, it was my typo: AddItem -> Add. I edited answer accordingly

J.T. Over a year ago

Wonderful! With that correction this is working perfectly! I will certainly have to learn more about using dictionary object. Thank you very much!

gembird · Accepted Answer · 2017-01-19 14:17:05Z

1

I would say you need Redim statement here:

'define last row
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

ReDim alpha_Assignment(1 To LastRow, 1 To 2) As Variant

' then loop
For i = LBound(alpha_Assignment) To UBound(alpha_Assignment)
    ' ...
Next i

answered Jan 19, 2017 at 14:17

gembird

14.1k5 gold badges39 silver badges54 bronze badges

Comments

Zerk · Accepted Answer · 2017-01-19 14:01:21Z

0

Your loop upper bound is defined here

For i = 1 To UBound(alpha_Assignment)

If you want it to loop to lastrow then adjust it to

For i = 1 To LastRow

answered Jan 19, 2017 at 14:01

Zerk

1,5939 silver badges16 bronze badges

1 Comment

J.T. Over a year ago

Thanks! That adjustment makes sense and it is now continuing but hitting error 9 'subscript out of range' once the loop gets to 27th loop. Is there another piece I'm missing?

Mr. Anderson · Accepted Answer · 2017-01-19 14:06:03Z

0

Your for...next is going from 1 to the upper bounds of the first element of alpha_assignment which based on the Dim is 26.

answered Jan 19, 2017 at 14:06

Mr. Anderson

1752 silver badges10 bronze badges

Collectives™ on Stack Overflow

Excel vba two dimensional array loop stops

4 Answers 4

3 Comments

Comments

1 Comment

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

3 Comments

Comments

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Related