VBA expected Array

R

Raymondc190466

New Member
Joined
Aug 19, 2016
Messages
24
Office Version
  1. 365
Platform
  1. Windows
I've got an excel code (different userforms), that was created by one of my colleagues.
So I have a little background of what the codes do.

This code creates an error message (compile error: expected array), and I can't figure out what is wrong.

This line of code causing the error:

Look_up_Data = Look_up_data_range.Value
ReDim Look_up_Data(End_line)

Code: 
Private Sub CommandButton1_Click()

Const Look_up_sheet = "Shelf_Life_900"
Const CST_First_Line = 2
Const CST_Item_Col = 1
Const CST_Shelf_Life_Col = 2
Const CST_Number_of_Periods = 3
Const CST_Technical_Responsible_Col = 4
Const CST_Date_Col = 5
Const CST_Remarks_Col = 6
Dim ctl_Cont As Control
Dim Row As Long
Dim ws As Worksheet
Dim MyString As String
Dim Item As Variant
Dim Look_up_data_range As Range
Dim Look_up_Data As String
Dim End_line As Integer
Dim Item_Name As String
Dim Item_exist As Boolean
Dim Index_Cell As Integer
Dim My_Cell As Variant
Dim x As Range


'Check if TxtBox_Item is not empty
If TxtBox_Item_Number.Text = "" Then
    MsgBox ("Item is not filled in")
    Exit Sub
End If


'Activate look up worksheet
Worksheets(Look_up_sheet).Activate
ActiveSheet.Unprotect
ActiveSheet.AutoFilterMode = False


'Read look data
Set x = Sheets("Request_for_Shelf_Life").Range("A:A").Find(TxtBox_Item_Number.Text)
    If Not x Is Nothing Then TxtBox_TC.Text = x.Offset(, 2).Value
Set Look_up_data_range = ActiveSheet.UsedRange
End_line = Look_up_data_range.Rows.Count
Set Look_up_data_range = ActiveSheet.Range( _
            ActiveSheet.Cells(CST_First_Line, CST_Item_Col), _
            ActiveSheet.Cells(End_line, CST_Item_Col))


Look_up_Data = Look_up_data_range.Value
ReDim Look_up_Data(End_line)
Index_Cell = 0
For Each My_Cell In Look_up_data_range.Cells
   Look_up_Data(Index_Cell) = My_Cell.Value
   Index_Cell = Index_Cell + 1
Next My_Cell
                
'Check If data already present
Item_Name = TxtBox_Item_Number.Text
Item_exist = False
For Each Item In Look_up_Data
    If Item = Item_Name Then
        Item_exist = True
        Exit For
    End If
Next Item
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
The compile error is because you've got:

Code: 
Dim Look_up_Data As String
....
ReDim Look_up_Data(End_line)

If you're going to use ReDim once you know how big to make the array, you should declare the variable as an array initially:

Code: 
Dim Look_up_Data[B][COLOR=#ff0000]()[/COLOR][/B] As String

BUT ....

It looks like there might be other problems with your code ...

This line, for example, looks like it's meant to assign the values in a 2-D range Look_up_data_range to a VBA array. However, this will only work if Look_up_Data is of type Variant, not String or any other type.

Code: 
Look_up_Data = Look_up_data_range.Value
Did your colleague have the code working? Have you perhaps made changes to code that was once working?
 
Upvote 0
Doesn't work here anymore.
And the assign it to me (as "Chinese Volunteer")

Don't know if it was working at all

I've changed :

Dim Look_up_data_range() As Range
Dim Look_up_Data As Variant

When I run the code now, I've got on following line the error message: Can't assign to array for this line:

Set Look_up_data_range = ActiveSheet.UsedRange
 
Upvote 0
This line was OK without the brackets:

Code: 
Dim Look_up_data_range[COLOR=#ff0000][B]()[/B][/COLOR] As Range

But before we go on making piecemeal changes ....

The code you've posted doesn't actually do a lot, and it does it in a roundabout way.

How much more code is there?

Perhaps the code never worked in the first place. If so, and if you're not clear what it's intended to do, then potentially, it's going to be difficult to "correct".
 
Upvote 0
As I've mentioned, they have assign it to me.
So I don't know if it has worked at all.

Below the complete code of the 5 different userforms.

Userform1:
Code: 
Private Sub CmdBtn_Check_Shelf_Life_Click()UserForm1.Hide
UserForm2.Show


End Sub


Private Sub CmdBtn_Invoeren_Shelf_Life_900_Click()
UserForm1.Hide
UserForm3.Show


End Sub


Private Sub CmdBtn_Local_Company_Click()
UserForm1.Hide
UserForm4.Show
End Sub


Private Sub CmdBtn_IQC_Click()
UserForm1.Hide
UserForm4.Show
End Sub


Private Sub CmdBtn_View_Excel_Click()


Dim Password As String
Answer = InputBox("Enter Password")
Password = "xxyyzz"


If Answer = Password Then
Application.Visible = True
'Worksheets("Shelf_Life_900").Activate
UserForm1.Hide
'CmdBtn_View_Excel.Enabled = True
Else
CmdBtn_View_Excel.Enabled = True
End If


End Sub

Userform2:
Code: 
Option Explicit

Private Sub UserForm_Initialize()
     UserForm1.BackColor = RGB(153, 204, 153)
Dim v, e


With Sheets("LookUpList").Range("A1:A5")
    v = .Value
End With
With CreateObject("scripting.dictionary")
    .comparemode = 1
    For Each e In v
        If Not .exists(e) Then .Add e, Nothing
    Next
    If .Count Then Me.CmbBox_Period.List = Application.Transpose(.keys)
End With
     
End Sub
Private Sub CommandButton2_Click()


Worksheets("Shelf_Life_900").Activate
UserForm2.Hide
    
End Sub


Private Sub CommandButton3_Click()


UserForm2.Hide
UserForm1.Show


End Sub
Private Sub CommandButton1_Click()


Const Look_up_sheet = "Shelf_Life_900"
Const CST_First_Line = 2
Const CST_Item_Col = 1
Const CST_Shelf_Life_Col = 2
Const CST_Number_of_Periods = 3
Const CST_Technical_Responsible_Col = 4
Const CST_Date_Col = 5
Const CST_Remarks_Col = 6
Dim ctl_Cont As Control
Dim Row As Long
Dim ws As Worksheet
Dim MyString As String
Dim Item As Variant
Dim Look_up_data_range As Range
Dim Look_up_Data() As String
Dim End_line As Integer
Dim Item_Name As String
Dim Item_exist As Boolean
Dim Index_Cell As Integer
Dim My_Cell As Variant
Dim x As Range


'Check if TxtBox_Item is not empty
If TxtBox_Item_Number.Text = "" Then
    MsgBox ("Item is not filled in")
    Exit Sub
End If


'Activate look up worksheet
Worksheets(Look_up_sheet).Activate
ActiveSheet.Unprotect
ActiveSheet.AutoFilterMode = False


'Read look data
Set x = Sheets("Request_for_Shelf_Life").Range("A:A").Find(TxtBox_Item_Number.Text)
    If Not x Is Nothing Then TxtBox_TC.Text = x.Offset(, 2).Value
'Set Look_up_data_range = ActiveSheet.UsedRange
'End_line = Look_up_data_range.Rows.Count
'Set Look_up_data_range = ActiveSheet.Range( _
            ActiveSheet.Cells(CST_First_Line, CST_Item_Col), _
            ActiveSheet.Cells(End_line, CST_Item_Col))


'Look_up_Data = Look_up_data_range.Value
ReDim Look_up_Data(End_line)
Index_Cell = 0
For Each My_Cell In Look_up_data_range.Cells
    Look_up_Data(Index_Cell) = My_Cell.Value
    Index_Cell = Index_Cell + 1
Next My_Cell
                
'Check If data already present
Item_Name = TxtBox_Item_Number.Text
Item_exist = False
For Each Item In Look_up_Data
    If Item = Item_Name Then
        Item_exist = True
        Exit For
    End If
Next Item
       
'Msg box if item exist
If Item_exist = True Then
    MsgBox (Item_Name & " " & "already excists")
Else
    
    'Check if CmbBox_Period is not empty
    If CmbBox_Period.Text = "" Then
        MsgBox ("Shelf Life Period is not filled in")
        Exit Sub
    End If
    
    'Check if TxtBox_Shelf_Life is not empty
    If TxtBox_Shelf_Life.Text = "" Then
        MsgBox ("Number of Periods is not filled in")
        Exit Sub
    End If
    
    'Check if Technical Responsible is not empty
    If TxtBox_TC.Text = "" Then
        MsgBox ("Requester is not filled in")
        Exit Sub
    End If
    
    'Fill in the cells
     Application.ActiveSheet.Cells(End_line + 1, CST_Item_Col).Value = TxtBox_Item_Number.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Shelf_Life_Col).Value = CmbBox_Period.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Number_of_Periods).Value = TxtBox_Shelf_Life.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Technical_Responsible_Col).Value = TxtBox_TC.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Remarks_Col).Value = TxtBox_Remarks.Text
     
     'Clear the text boxes
     TxtBox_Item_Number.Text = ""
     CmbBox_Period.Text = ""
     TxtBox_Shelf_Life.Text = ""
     TxtBox_TC.Text = ""
     TxtBox_Remarks = ""
End If


End Sub

Userform3:
Code: 
Private Sub CommandButton2_Click()

UserForm3.Hide
UserForm1.Show


End Sub


Private Sub CommandButton1_Click()


Const Look_up_sheet = "Request_for_Shelf_Life"
Const CST_First_Line = 2
Const CST_Item_Col = 1
Const CST_Request_Col = 2
Const CST_Department_Col = 3
Const CST_Responsible_Col = 4
Dim ctl_Cont As Control
Dim Row As Long
Dim ws As Worksheet
Dim MyString As String
Dim Item As Variant
Dim Look_up_data_range As Range
Dim Look_up_Data() As String
Dim End_line As Integer
Dim Item_Name As String
Dim Item_exist As Boolean
Dim Index_Cell As Integer




'Check if TxtBox_Item is not empty
If TxtBox_Item.Text = "" Then
    MsgBox ("Item is not filled in")
    Exit Sub
End If


'Activate look up worksheet
Worksheets(Look_up_sheet).Activate
ActiveSheet.Unprotect
ActiveSheet.AutoFilterMode = False


'Read look data
Set Look_up_data_range = ActiveSheet.UsedRange
End_line = Look_up_data_range.Rows.Count
Set Look_up_data_range = ActiveSheet.Range( _
            ActiveSheet.Cells(CST_First_Line, CST_Item_Col), _
            ActiveSheet.Cells(End_line, CST_Item_Col))
'Look_up_Data = Look_up_data_range.Value
ReDim Look_up_Data(End_line)
Index_Cell = 0
For Each My_Cell In Look_up_data_range.Cells
    Look_up_Data(Index_Cell) = My_Cell.Value
    Index_Cell = Index_Cell + 1
Next My_Cell
        
        
        
'Check If data already present
Item_Name = TxtBox_Item.Text
Item_exist = False
For Each Item In Look_up_Data
    If Item = Item_Name Then
        Item_exist = True
        Exit For
    End If
Next Item
       
'Msg box if item exist
If Item_exist = True Then
    MsgBox (Item_Name & " " & "already exists")
Else
    
    'Check if TxtBox_Requester is not empty
    If TxtBox_Requester.Text = "" Then
        MsgBox ("Requester is not filled in")
        Exit Sub
    End If
    
    'Check if TxtBox_Requester is not empty
    If TxtBox_Afdeling.Text = "" Then
        MsgBox ("Department is not filled in")
        Exit Sub
    End If
    
    'Check if Responsible is not empty
    If TxtBox_TC.Text = "" Then
        MsgBox ("Technical Responsible is not filled in")
        Exit Sub
    End If
    
    'Fill in the cells
     Application.ActiveSheet.Cells(End_line + 1, CST_Item_Col).Value = TxtBox_Item.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Request_Col).Value = TxtBox_Requester.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Department_Col).Value = TxtBox_Afdeling.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Responsible_Col).Value = TxtBox_TC.Text
     
     'Clear the text boxes
     TxtBox_Item.Text = ""
     TxtBox_Requester.Text = ""
     TxtBox_Afdeling.Text = ""
     TxtBox_TC.Text = ""
End If


End Sub

Userform4:
Code: 
Private Sub CmdBtn_Local_Company_Click()


Const Look_up_sheet = "Local_Company"
Const CST_First_Line = 2
Const CST_Item_Col = 1
Const CST_Division_Col = 2
Const CST_Responsible_Col = 3
Const CST_Company_Col = 4
Dim ctl_Cont As Control
Dim Row As Long
Dim ws As Worksheet
Dim MyString As String
Dim Item As Variant
Dim Look_up_data_range As Range
Dim Look_up_Data() As String
Dim End_line As Integer
Dim Item_Name As String
Dim Item_exist As Boolean
Dim Index_Cell As Integer
Dim My_Cell As Variant




'Check if TxtBox_Item is not empty
If TxtBox_Item_Number.Text = "" Then
    MsgBox ("Item is not filled in")
    Exit Sub
End If


'Activate look up worksheet
Worksheets(Look_up_sheet).Activate
ActiveSheet.Unprotect
ActiveSheet.AutoFilterMode = False


'Read look data
Set Look_up_data_range = ActiveSheet.UsedRange
End_line = Look_up_data_range.Rows.Count
Set Look_up_data_range = ActiveSheet.Range( _
            ActiveSheet.Cells(CST_First_Line, CST_Item_Col), _
            ActiveSheet.Cells(End_line, CST_Item_Col))


'Look_up_Data = Look_up_data_range.Value
ReDim Look_up_Data(End_line)
Index_Cell = 0
For Each My_Cell In Look_up_data_range.Cells
    Look_up_Data(Index_Cell) = My_Cell.Value
    Index_Cell = Index_Cell + 1
Next My_Cell
                
'Check If data already present
Item_Name = TxtBox_Item_Number.Text
Item_exist = False
For Each Item In Look_up_Data
    If Item = Item_Name Then
        Item_exist = True
        Exit For
    End If
Next Item
       
'Msg box if item exist
If Item_exist = True Then
    MsgBox (Item_Name & " " & "already exists")
Else
    
    'Check if TxtBox_Division is not empty
    If TxtBox_Division.Text = "" Then
        MsgBox ("Division is not filled in")
        Exit Sub
    End If
    
    'Check if TxtBox_Responsible is not empty
    If TxtBox_Responsible.Text = "" Then
        MsgBox ("Responsible is not filled in")
        Exit Sub
    End If
    
    'Check if TxtBox_Company is not empty
    If TxtBOx_Company.Text = "" Then
        MsgBox ("Local Company is not filled in")
        Exit Sub
    End If
    
    'Fill in the cells
     Application.ActiveSheet.Cells(End_line + 1, CST_Item_Col).Value = TxtBox_Item_Number.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Division_Col).Value = TxtBox_Division.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Responsible_Col).Value = TxtBox_Responsible.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Company_Col).Value = TxtBOx_Company.Text
     
     'Clear the text boxes
     TxtBox_Item_Number.Text = ""
     TxtBox_Division.Text = ""
     TxtBox_Responsible.Text = ""
     TxtBOx_Company.Text = ""


End If


End Sub




Private Sub CmdBtn_Menu_Click()


UserForm4.Hide
UserForm1.Show


End Sub




Private Sub CmdBtn_View_Excel_Click()


Worksheets("Local_Company").Activate
UserForm4.Hide


End Sub

Userform5:
Code: 
Private Sub CmdBtn_IQC_Click()

UserForm3.Hide
UserForm1.Show


End Sub


Private Sub CmdBtn_IQC_Write_Click()


Const Look_up_sheet = "IQC"
Const CST_First_Line = 2
Const CST_Item_Col = 1
Const CST_Responsible_Col = 2
Const CST_Refrigerator_Col = 3
Dim ctl_Cont As Control
Dim Row As Long
Dim ws As Worksheet
Dim MyString As String
Dim Item As Variant
Dim Look_up_data_range As Range
Dim Look_up_Data() As String
Dim End_line As Integer
Dim Item_Name As String
Dim Item_exist As Boolean
Dim Index_Cell As Integer




'Check if TxtBox_Item is not empty
If TxtBox_Item_Number.Text = "" Then
    MsgBox ("Item is not filled in")
    Exit Sub
End If


'Activate look up worksheet
Worksheets(Look_up_sheet).Activate
ActiveSheet.Unprotect
ActiveSheet.AutoFilterMode = False


'Read look data
Set Look_up_data_range = ActiveSheet.UsedRange
End_line = Look_up_data_range.Rows.Count
Set Look_up_data_range = ActiveSheet.Range( _
            ActiveSheet.Cells(CST_First_Line, CST_Item_Col), _
            ActiveSheet.Cells(End_line, CST_Item_Col))
'Look_up_Data = Look_up_data_range.Value
ReDim Look_up_Data(End_line)
Index_Cell = 0
For Each My_Cell In Look_up_data_range.Cells
    Look_up_Data(Index_Cell) = My_Cell.Value
    Index_Cell = Index_Cell + 1
Next My_Cell
        
        
        
'Check If data already present
Item_Name = TxtBox_Item_Number.Text
Item_exist = False
For Each Item In Look_up_Data
    If Item = Item_Name Then
        Item_exist = True
        Exit For
    End If
Next Item
       
'Msg box if item exist
If Item_exist = True Then
    MsgBox (Item_Name & " " & "already exists")
Else
    
    'Check if TxtBox_Responsible is not empty
    If TxtBox_Responsible.Text = "" Then
        MsgBox ("Reponsible is not filled in")
        Exit Sub
    End If
    
    'Check if TxtBox_Refrigerator is not empty
    If TxtBox_Refrigerator.Text = "" Then
        MsgBox ("Refrigerator is not filled in")
        Exit Sub
    End If
    
    
    'Fill in the cells
     Application.ActiveSheet.Cells(End_line + 1, CST_Item_Col).Value = TxtBox_Item_Number.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Responsible_Col).Value = TxtBox_Responsible.Text
     Application.ActiveSheet.Cells(End_line + 1, CST_Refrigerator_Col).Value = TxtBox_Refrigerator.Text
     
     'Clear the text boxes
     TxtBox_Item_Number.Text = ""
     TxtBox_Responsible.Text = ""
     TxtBox_Refrigerator.Text = ""
     
End If


End Sub


Private Sub CmdBtn_Menu_Click()
UserForm5.Hide
UserForm1.Show
End Sub


Private Sub CmdBtn_View_Excel_Click()
Worksheets("IQC").Activate
UserForm5.Hide
End Sub
 
Upvote 0
As a first step, try replacing all this code (from Sub CommandButton1_Click in UserForm2):
Code: 
Look_up_Data = Look_up_data_range.Value
ReDim Look_up_Data(End_line)
Index_Cell = 0
For Each My_Cell In Look_up_data_range.Cells
   Look_up_Data(Index_Cell) = My_Cell.Value
   Index_Cell = Index_Cell + 1
Next My_Cell
                
'Check If data already present
Item_Name = TxtBox_Item_Number.Text
Item_exist = False
For Each Item In Look_up_Data
    If Item = Item_Name Then
        Item_exist = True
        Exit For
    End If
Next Item

With:

Code: 
Item_exist = Not IsError(Application.Match(TxtBox_Item_Number.Text, Look_up_data_range, 0))
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,315
Messages
6,171,409
Members
452,399
Latest member
oranges

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top