Expected array ошибка vba excel

Can anyone help me?

I have been getting a compile error (…: «Expected Array») when dealing with arrays in my Excel workbook.

Basically, I have one ‘mother’ array (2D, Variant type) and four ‘baby’ arrays (1D, Double type). The called subroutine creates the publicly declared arrays which my main macro ends up using for display purposes. Unfortunately, the final of the baby arrays craps out (giving the «Compile Error: Expected Array»). Strangely, if I remove this final baby array (‘final’ — as in the order of declaration/definition) the 2nd to last baby array starts crapping out.

Here is my code:

 Public Mother_Array() as Variant, BabyOne_Array(), BabyTwo_Array(), BabyThree_Array(), BabyFour_Array() as Double 'declare may other variables and arrays, too

Sub MainMacro()
    'do stuff

   Call SunRaySubRoutine(x, y)

    'do stuff

    Range("blah") = BabyOne_Array: Range("blahblah") = BabyTwo_Array
    Range("blahbloh" = BabyThree_Array: Range("blahblue") = BabyFour_Array

End Sub

Sub SunRaySubRoutine(x,y)
    n = x * Sheets("ABC").Range("A1").Value + 1

    ReDim Mother_Array(18, n) as Variant, BabyOne_Array(n), BabyTwo_Array(n) as Double
    ReDim BabyThree_Array(n), BabyFour_Array(n) as Double

    'do stuff

    For i = 0 to n

        BabyOne_Array(i) = Mother_Array(0,i)
        BabyTwo_Array(i) = Mother_Array(2,i)
        BabyThree_Array(i) = Mother_Array(4,i)
        BabyFour_Array(i) = Mother_Array(6,i)
    Next        

End Sub

I have tried to declare all arrays as the Variant type, but to no avail. I have tried to give BabyFour_Array() a different name, but to no avail.

What’s really strange is that even if I comment out the part which makes the BabyFour_Array(), the array still has zero values for each element.

What’s also a bit strange is that the first baby array never craps out (although, the 2nd one crapped out once (one time out of maybe 30).

BANDAID: As a temporary fix, I just publicly declared a fifth dummy array (which doesn’t get filled or Re-Dimensioned). This fifth array has no actual use besides tricking the system out of having the «Compile Error: Expected Array».

Does anyone know what’s causing this «Compile Error: Expected Array» problem with Excel VBA?

Thanks,

Elias

Источник

Dobemanik

Пользователь

Сообщений: 3
Регистрация: 30.01.2018

30.01.2018 14:03:12

Начал изучать vba, выходит такая ошибка

Код

Sub z3()
Dim a, b, h, x, f As Single
a = 1
b = 100
h = 4
With Worksheets(1)
.cell(1, 1).Value = "x"
.cell(1, 2).Value = "f(x)"
For x = a To b Step h
i = i + 1
f = x - Cos(Abs(x ^ 1 / 2))
.cell(i + 1, 1).Value = x
.cell(i + 1, 2).Value = f(x)
Next x
End With
End Sub

Изменено: Dobemanik — 30.01.2018 14:40:17

Пользователь

Сообщений: 4999
Регистрация: 22.12.2012

30.01.2018 14:05:59

Цитата
Dobemanik написал: .cell(i + 1, 2).Value = f(x)

первое что кинулось в глаза, что за f(x)
П.С. оформляйте код тегом.

Изменено: V — 30.01.2018 14:06:58

V Пользователь Сообщений: 4999 Регистрация: 22.12.2012	вы в курсе что при такой записи Dim a, b, h, x, f As Single — a, b, h, x будут иметь тип вариант? Изменено: V — 30.01.2018 14:09:01

Sanja

Пользователь

Сообщений: 14837
Регистрация: 10.01.2013

30.01.2018 14:10:31

Код

Sub z3()
Dim a, b, h, x, f As Single
a = 1: b = 100: h = 4
With Worksheets(1)
    .cell(1, 1).Value = "x"
    .cell(1, 2).Value = "f(x)"
    i = 1
    For x = a To b Step h
        f = x - Cos(Abs(x ^ 1 / 2))
        i = i + 1
        .cell(i, 1).Value = x
        .cell(i, 2).Value = f
    Next x
End With
End Sub

Согласие есть продукт при полном непротивлении сторон.

Ігор Гончаренко

Пользователь

Сообщений: 13146
Регистрация: 01.01.1970

30.01.2018 14:11:19

а так:

Код
.cell(i + 1, 2).Value = f

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Dobemanik

Пользователь

Сообщений: 3
Регистрация: 30.01.2018

30.01.2018 14:13:05

Цитата
V написал: вы в курсе что при такой записи Dim a, b, h, x, f As Single — a, b, h, x будут иметь тип вариант?

Делал по учебнику, через тип variant возникает ошибка 438, прописывал каждую переменную отдельно-снова ошибка с массивом

V Пользователь Сообщений: 4999 Регистрация: 22.12.2012	Dobemanik, это был не ответ а просто для информации. Ответ был пост ранее.

Пользователь

Сообщений: 4999
Регистрация: 22.12.2012

30.01.2018 14:16:08

Цитата
Dobemanik написал: снова ошибка с массивом

нет у вас массива. Вы сразу на лист выгружаете.

Nordheim

Пользователь

Сообщений: 3154
Регистрация: 18.04.2017

30.01.2018 14:19:21

Код
.cell(1, 1).Value

Можно узнать , что такое cell в данном выражении, это вроде как не переменная.
м.б. стоит написать

Код
.cells(1, 1).Value

«Все гениальное просто, а все простое гениально!!!»

Казанский

Пользователь

Сообщений: 8839
Регистрация: 11.01.2013

#10

30.01.2018 14:22:05

Цитата
Dobemanik написал: Делал по учебнику

В учебнике написано «первым делом зайдите в Tools — Options и включите Require Variables Declaration»?
Если нет — выбросьте этот учебник. И таки включите указанную опцию. Ошибок будет в несколько раз меньше.

Dobemanik

Пользователь

Сообщений: 3
Регистрация: 30.01.2018

#11

30.01.2018 14:22:22

Цитата
Nordheim написал: м.б. стоит написать Код ? 1.cells(1, 1).Value

Благодарю, помогло

Nordheim Пользователь Сообщений: 3154 Регистрация: 18.04.2017	#12 30.01.2018 14:26:05 Я и не сомневался, что поможет. Но вот про объявление переменных стоит почитать. Но за основу я брал не ваш код а из сообщения №4 Изменено: Nordheim — 30.01.2018 14:29:31 «Все гениальное просто, а все простое гениально!!!»

Источник

Permalink

Cannot retrieve contributors at this time

title	keywords	f1_keywords	ms.prod	ms.assetid	ms.date	ms.localizationpriority
Expected array	vblr6.chm1011151	vblr6.chm1011151	office	9b38809b-2fc1-8bcf-f13e-05570fd1673c	06/08/2017	medium

A variable name with a subscript indicates the variable is an array. This error has the following cause and solution:

The syntax you specified is appropriate for an array, but no array with this name is in scope.

Check to make sure the name of the variable is spelled correctly. Unless the module contains Option Explicit, a variable is created on first use. If you misspell the name of an array variable, the variable may be created, but not as an array.

For additional information, select the item in question and press F1 (in Windows) or HELP (on the Macintosh).

[!includeSupport and feedback]

Источник

McMerlin

0 / 0 / 0

Регистрация: 07.05.2021

Сообщений: 6

Excel

12.05.2021, 15:35. Показов 1700. Ответов 8

Метки vba excel (Все метки)

Добрый день!

Не получается получить массив, в чем ошибка?

Visual Basic

Sub Cheken()
    Dim ReCheken As Range
    Dim RX As Variant
    Dim i As Long
        i = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
        ReCheken = ActiveSheet.Range(ActiveSheet.Cells(i, 19)).Value
        RX = Range("V1")
                For i = 2 To UBound(ReCheken, 1)
            If ReCheken = "<<<< Отсутствует в базе данных, необходимо обратиться к менеджеру по продукту >>>>" Then
                Cells(ReCheken.Row, 1) = Replace(Cells(ReCheken.Row, 1), "000", RX)
            End If
        Next i
End Sub

Вложения

Тестовый 2.7z (16.8 Кб, 7 просмотров)

__________________
Помощь в написании контрольных, курсовых и дипломных работ, диссертаций здесь

Zeag

680 / 451 / 180

Регистрация: 09.03.2009

Сообщений: 1,539

12.05.2021, 15:43

Это ЗНАЧЕНИЕ. Одно значение.

Visual Basic

1	ReCheken = ActiveSheet.Range(ActiveSheet.Cells(i, 19)).Value

А здесь пробуем взять размер МАССИВА.

Visual Basic

1	For i = 2 To UBound(ReCheken, 1)

3815 / 2244 / 749

Регистрация: 02.11.2012

Сообщений: 5,894

12.05.2021, 16:23

Цитата
Сообщение от McMerlin
Посмотреть сообщение

Dim ReCheken As Range

у Range нет UBound.

0 / 0 / 0

Регистрация: 07.05.2021

Сообщений: 6

13.05.2021, 11:05

[ТС]

Как правильно указать диапазон для 19 столбца?

Vlad999

3815 / 2244 / 749

Регистрация: 02.11.2012

Сообщений: 5,894

13.05.2021, 14:44

вариант

Visual Basic

1 2	Dim ReCheken() ReCheken = ActiveSheet.Range(ActiveSheet.Cells(4, 19),ActiveSheet.Cells(i, 19)).Value

McMerlin

0 / 0 / 0

Регистрация: 07.05.2021

Сообщений: 6

13.05.2021, 15:00

[ТС]

Выдает ошибку «type mismatch»

Visual Basic

Sub Cheken()
    Dim ReCheken()
    Dim RX As Variant
    Dim i As Long
        With Sheets("Лист1")
            i = .UsedRange.Row + .UsedRange.Rows.Count - 1
            ReCheken = .Range(.Cells(4, 19), .Cells(i, 19)).Value
            RX = Range("V1")
                For i = 2 To Range(ReCheken, 1)
                    If ReCheken = "<<<< Отсутствует в базе данных, необходимо обратиться к менеджеру по продукту >>>>" Then
                        ' замена трех последних значений на случайный код из ячейки V1
                        Cells(ReCheken.Row, 1) = Replace(Cells(ReCheken.Row, 1), "000", RX)
                    End If
                Next i
        End With
End Sub

Vlad999

3815 / 2244 / 749

Регистрация: 02.11.2012

Сообщений: 5,894

13.05.2021, 15:28

вы путаете массив и диапазон. Разберитесь что есть что.

Добавлено через 2 минуты
разбирайтесь. Используется диапазон.

Visual Basic

Sub Cheken()
    Dim ReCheken As Range
    Dim RX As Variant
    Dim i As Long
        With Sheets("Лист1")
            i = .UsedRange.Row + .UsedRange.Rows.Count - 1
            Set ReCheken = .Range(.Cells(4, 19), .Cells(i, 19))
            RX = Range("V1")
                For Each R In ReCheken
                    If R = "<<<< Отсутствует в базе данных, необходимо обратиться к менеджеру по продукту >>>>" Then
                        ' замена трех последних значений на случайный код из ячейки V1
                        Cells(R.Row, 1) = Replace(Cells(R.Row, 1), "000", RX)
                    End If
                Next
        End With
End Sub

0 / 0 / 0

Регистрация: 07.05.2021

Сообщений: 6

13.05.2021, 16:14

[ТС]

А для чего функция For Each, когда нужна функция For, что бы в каждой строке было разное значение?

3815 / 2244 / 749

Регистрация: 02.11.2012

Сообщений: 5,894

14.05.2021, 08:11

Цитата
Сообщение от McMerlin
Посмотреть сообщение

А для чего функция For Each

Это тоже цикл что и FOR, только принцип его работы другой.

Источник

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?

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

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».

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

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))

Источник

Hi Experts,.

I’m writing vba code to import the excel file. While running the below code, I’m getting the error as
Expected Array for the line strFilter = ahtAddFilterItem(strFilter, «Excel Files (*.xls)», «*.XLS»)

some one please let me know what’s the mistake I’m doing here! For your reference, I have inserted the complete code below.

Any help would be highly appreciated.

Many Thanks!

Sub Button1_Click()
Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
Dim blnHasFieldNames As Boolean
Dim ahtAddFilterItem As String

blnHasFieldNames = False

strBrowseMsg = «Select the EXCEL file:»

‘strInitialDirectory = «C:UsersPZ8P95DesktopExcel testing»

strFilter = ahtAddFilterItem(strFilter, «Excel Files (*.xls)», «*.XLS»)

strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
      Filter:=strFilter, OpenFile:=False, _
      DialogTitle:=strBrowseMsg, _
      Flags:=ahtOFN_OVERWRITEPROMPT)

If strPathFile = «» Then
MsgBox «No file was selected.», vbOK, «No Selection»
Exit Sub
End If

‘ Replace tablename with the real name of the table into which
‘ the data are to be imported
strTable = «Excel file.xls»

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames

‘ Uncomment out the next code step if you want to delete the
‘ EXCEL file after

End Sub

Источник

Expected array ошибка vba excel

А вот еще интересные материалы: