Array is locked error

[niall91]

Hi guys

Im getting an error message when i try to ReDim Preserve my array to take out all the empty positions.
the error is 'This array is fixed or temporarily locked'. any ideas?

Private Sub ComboBox1_Change()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sales Chart")
Dim i As Integer, r As Integer, n As Integer, lr As Integer
Dim additeam As Boolean
Dim myarray() As Variant, iteam As Variant
n = Application.WorksheetFunction.Match(Me.ComboBox1.Value, sh.Range("B:B"), 0)

Me.ComboBox2.Clear
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
r = 0
ReDim myarray(0 To lr)

For i = n To lr
    If sh.Cells(i, 2) = Me.ComboBox1.Value Then
        If myarray(r) = "" Then
              myarray(r) = sh.Cells(i, 4).Value
                        Else
                        For Each iteam In myarray()
                            If sh.Cells(i, 4) = iteam Then
                                additeam = False
                                GoTo nexti
                                    Else
                                        additeam = True
                            End If
                        Next iteam
                                If additeam = True Then
                                    r = r + 1
                                    myarray(r) = sh.Cells(i, 4).Value
                                End If
        End If
    End If
    
nexti:
Next i

ReDim Preserve myarray(0 To r)

For i = LBound(myarray) To UBound(myarray)
    
    Me.ComboBox2.AddItem myarray(i)
    
Next i

End Sub

 

[Fluff]

Not sure why you are getting an error, but does this do what you want

Private Sub ComboBox1_Click()
   Dim Dic As Object
   Dim Cl As Range
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sales Chart")
      For Each Cl In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
         If Cl.Value = Me.ComboBox1.Value Then
            Dic(Cl.Offset(, 2).Value) = Empty
         End If
      Next Cl
   End With
   Me.ComboBox2.list = Dic.Keys
End Sub

 

[niall91]

Not sure why you are getting an error, but does this do what you want

Private Sub ComboBox1_Click()
   Dim Dic As Object
   Dim Cl As Range
  
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sales Chart")
      For Each Cl In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
         If Cl.Value = Me.ComboBox1.Value Then
            Dic(Cl.Offset(, 2).Value) = Empty
         End If
      Next Cl
   End With
   Me.ComboBox2.list = Dic.Keys
End Sub

This works really well thanks a million

 

[Fluff]

You're welcome & thanks for the feedback.