VBA dropdown list error

R

R2ah1ze1l

Board Regular
Joined
Nov 10, 2017
Messages
93
Code: 
    With wsReview.Range(Cells(9, 20), Cells(9, ic + lastr)).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _    <---Highlight in yellow
        Operator:=xlBetween, Formula1:="Pool"                             <---Arrow on this line
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

I am receiving a Run-time error '1004': Application-defined or object-defined error
I copied this from a recorded macro then edited the range selection.
 
Sort by date Sort by votes
Code: 
Private Sub CommandButton1_Click()

Dim wbReview As Workbook, wbExport As Workbook, wsReview As Worksheet, wsExport As Worksheet
Dim sReview As String, sExport As String, Rpath As String, Epath As String, FEpath As String, efil_nam As String
Dim Border_rng As Range, frmt_rng As Range, iss_num As Variant
Dim data_val() As Double, sn_val() As String, oper_val() As String, dt_val() As String, tm_val() As String
Dim MyList As String

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    iWindowState = .WindowState
    .WindowState = xlMinimized
End With

f_day = Day(Now)
f_mnth = Month(Now)
f_hr = Hour(Now)
f_min = Minute(Now)
f_ap = "A"
If f_hr < 10 Then
f_hr = Str("0" + f_hr)
End If
If f_min < 10 Then
f_min = Str("0" + f_min)
End If
If f_hr > 12 Then
f_hr = f_hr - 12
f_ap = "P"
End If


f_set = f_mnth & "_" & f_day & "_" & f_hr & f_min & f_ap

temp_dest = "C:\Eric\"

Set wbReview = ActiveWorkbook
Set wsReview = wbReview.Worksheets("Master_Data")

fl_split = wsReview.Range("D2").Value
iss_num = Format(wsReview.Range("E2").Value, "Standard")
pn_v = Split(fl_split, "_")(0) 'part number
pt_v = Split(fl_split, "_")(1) 'prog type
po_v = Split(fl_split, "_")(2) 'OP number
pm_v = Split(fl_split, "_")(3) 'Mach ID

efil_nam = fl_split & "-" & iss_num 'file and sheet title

Epath = "M:\Reports Archive\" & pn_v & "\" & "OP" & po_v & "\Export" 'Export folder location (2020 Template)
sExport = efil_nam & ".csv"                                          'CSV file name
FEpath = Epath & "\" & sExport
f_title = temp_dest & fl_split & "_" & f_set

Set wbExport = Workbooks.Open(FEpath)
Set wsExport = wbExport.Worksheets(efil_nam)

lastr = 0
lastc = 0
ir = 10
ic = 19
csvdata_start = 3


wsExport.Activate
wsExport.Range("A1").Activate
While Not ActiveCell = ""
lastr = lastr + 1
ActiveCell.Offset(1, 0).Activate
Wend
wsExport.Range("A1").Activate
While Not ActiveCell = ""
lastc = lastc + 1
ActiveCell.Offset(0, 1).Activate
Wend

ReDim sn_val(1 To lastr) As String
ReDim oper_val(1 To lastr) As String
ReDim dt_val(1 To lastr) As String
ReDim tm_val(1 To lastr) As String
ReDim data_val(1 To lastc) As Double                                    'was long when working

v = 0
While x < lastr
x = x + 1                                                               'begins rows
wsExport.Activate
        sn_val(x) = wsExport.Cells(x, 1).Value
        oper_val(x) = wsExport.Cells(x, 2).Value
        dt_val(x) = wsExport.Cells(x, 3).Value
        'tm_val(x) = wsExport.Cells(x, 4).Value
        While y < (lastc - csvdata_start)                               'begin column
        y = y + 1
        data_val(y) = wsExport.Cells(x, y + csvdata_start).Value
        data_val(y) = Format(data_val(y), "0.0000")
        Wend                                                            'end column
y = 0
wsReview.Activate
        wsReview.Cells(ir + 1, ic + x).Resize(UBound(data_val), 1).Value = Application.Transpose(data_val)
Wend
y = 0
x = 0
While x < lastr
x = x + 1
wsReview.Activate
        wsReview.Cells(2, ic + x).Value = sn_val(x)
        wsReview.Cells(3, ic + x).Value = oper_val(x)
        wsReview.Cells(4, ic + x).Value = dt_val(x)
        'wsReview.Cells(5, ic + x).Value = tm_val(x)
Wend                                                                   'end rows

wsExport.Activate
ActiveWorkbook.Close

wsReview.Activate
usl_d = wsReview.Range("J11").FormulaR1C1
lsl_d = wsReview.Range("K11").FormulaR1C1
max_d = wsReview.Range("L11").FormulaR1C1
min_d = wsReview.Range("M11").FormulaR1C1
rng_d = wsReview.Range("N11").FormulaR1C1
ptu_d = wsReview.Range("O11").FormulaR1C1
std_d = wsReview.Range("P11").FormulaR1C1
avg_d = wsReview.Range("Q11").FormulaR1C1
cpk_d = wsReview.Range("R11").FormulaR1C1


wsReview.Range(wsReview.Cells(11, 10), wsReview.Cells(lastc + ir - csvdata_start, 10)).FormulaR1C1 = Format(usl_d, "0.0000")
wsReview.Range(wsReview.Cells(11, 11), wsReview.Cells(lastc + ir - csvdata_start, 11)).FormulaR1C1 = Format(lsl_d, "0.0000")
wsReview.Range(wsReview.Cells(11, 12), wsReview.Cells(lastc + ir - csvdata_start, 12)).FormulaR1C1 = Format(max_d, "0.0000")
wsReview.Range(wsReview.Cells(11, 13), wsReview.Cells(lastc + ir - csvdata_start, 13)).FormulaR1C1 = Format(min_d, "0.0000")
wsReview.Range(wsReview.Cells(11, 14), wsReview.Cells(lastc + ir - csvdata_start, 14)).FormulaR1C1 = Format(rng_d, "0.0000")
wsReview.Range(wsReview.Cells(11, 15), wsReview.Cells(lastc + ir - csvdata_start, 15)).FormulaR1C1 = ptu_d
wsReview.Range(wsReview.Cells(11, 16), wsReview.Cells(lastc + ir - csvdata_start, 16)).FormulaR1C1 = Format(std_d, "0.0000")
wsReview.Range(wsReview.Cells(11, 17), wsReview.Cells(lastc + ir - csvdata_start, 17)).FormulaR1C1 = Format(avg_d, "0.0000")
wsReview.Range(wsReview.Cells(11, 18), wsReview.Cells(lastc + ir - csvdata_start, 18)).FormulaR1C1 = Format(cpk_d, "0.0000")


'Generate dropdown list along row 9
wsReview.Range(Cells(9, 20), Cells(9, ic + lastr)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$A$1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

i = 0
wsReview.Activate
For i = 1 To lastr
    wsReview.Cells(1, ic + i).Value = i 'fills ID_Order
Next i
For i = 1 To (lastc - csvdata_start)
    wsReview.Cells(ir + i, 1).Value = i ' fills CH_Order
Next i

wsReview.Range(wsReview.Cells(1, 1), wsReview.Cells(ir + lastc - csvdata_start, lastr + ic)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With

wsReview.Range(wsReview.Cells(10, 1), wsReview.Cells(10, lastr + ic)).Select
Selection.AutoFilter

ActiveSheet.UsedRange.Columns.AutoFit
ActiveSheet.Columns("A:AAA").HorizontalAlignment = xlCenter

ActiveWorkbook.SaveAs Filename:=f_title
Range("A11").Select

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    iWindowState = .WindowState
    .WindowState = xlMaximized
End With
End Sub

Here is the whole code as is. The area I'm working on is about 3/4 way through the routine.
By qualified, you mean Dim a new range and Set it?
 
Upvote 0

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
As in:
With wsReview.Range(wsReview.Cells(9, 20), wsReview.Cells(9, ic + lastr)).Validation
 
Upvote 0
I'm still getting the 1004 error.
I tested and the range is at least being selected on the worksheet.
 
Upvote 0
The issue with the 1004 error was the window being minimized.
Also moved the list into it's own module. Here is the working result:
Code: 
Sub list_create(lastr As Integer)
Dim ws As Worksheet
Dim rng As Range, rngSelect As Range
lastr = lastr + 19

Set ws = ThisWorkbook.Worksheets("Master_Data")
Range(Cells(9, 20), Cells(9, lastr)).Select

Application.WindowState = xlMaximized

With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:="Keep"
End With
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

U
  • Question
recorded macro throwing 1004 error
Replies
3
Views
365
ursua
U
MartinS
  • Solved
Update Validation in Merged Cells
2
Replies
10
Views
125
Joe4
Joe4
V
  • Question
Excel VBA to Create Data Validation List from Range with Filter
Replies
1
Views
799
RoryA
RoryA
D
  • Solved
Add/clear drop down (data validation) based upon a cell's content
Replies
7
Views
1K
dmj120
D
J
  • Question
Data Validation list that pulls from multiple columns in active row?
Replies
7
Views
556
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,950
Messages
6,122,428
Members
449,083
Latest member
Ava19

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