Create Excel Column with Header and Dropdown from inside Access

This code works when I run it from inside Excel:
Public Sub TestInsert()
Dim strValueList As String, strHeader As String

strValueList = "Agree to Pay,Already Paid,Ineligible for Payment,More Info Needed,Other"
strHeader = "StatusPerCarrier"

Range("$Y$1").Value = strHeader

With Range("Y2:Y30").Validation
   .Delete
   .Add _
   Type:=xlValidateList, _
   AlertStyle:=xlValidAlertStop, _
   Formula1:=strValueList
   
End With

End Sub

Open in new window


When I try running it from inside Access,   the dropdown is created and populated, but the header cell isn't.  What am I missing?
Public Sub TestInsert()
Dim strValueList As String, strHeader As String
Dim xlApp As Object, xlWorkBook As Object, xlWorkSheet As Object, strWorksheetName As String

10    strValueList = "Agree to Pay,Already Paid,Ineligible for Payment,More Info Needed,Other"
20    strHeader = "StatusPerCarrier"

30    Set xlApp = CreateObject("Excel.Application")
40    Set xlWorkBook = xlApp.Workbooks.Open("C:\Database\Providence_20150604.xlsx")
50    Set xlWorkSheet = xlWorkBook.Worksheets(1)
60        With xlWorkSheet


70      With Range("$Y$1").Value = strHeader
80    End With

90    With Range("Y2:Y29").Validation
100   .Delete
110   .Add _
   TYPE:=xlValidateList, _
   AlertStyle:=xlValidAlertStop, _
   Formula1:=strValueList
120   End With
130   End With


      'close down Excel:
140   Set xlWorkSheet = Nothing
150   xlWorkBook.Save
160   xlWorkBook.Close
170   Set xlWorkBook = Nothing
180   xlApp.Quit
190   xlApp.Application.Quit
200   Set xlApp = Nothing

MsgBox "Ding!"

End Sub

Open in new window

LVL 8
Paul Cook-GilesSenior Application DeveloperAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
You are missing dot qualifiers in front of Range and you probably need to declare the constants you are using in the code.

Try this.
Option Explicit

Const xlValidateList = 2
Const xlValidAlertStop = 1

Public Sub TestInsert()
Dim strValueList As String, strHeader As String
Dim xlApp As Object, xlWorkBook As Object, xlWorkSheet As Object, strWorksheetName As String

    strValueList = "Agree to Pay,Already Paid,Ineligible for Payment,More Info Needed,Other"
    strHeader = "StatusPerCarrier"

    Set xlApp = CreateObject("Excel.Application")
    Set xlWorkBook = xlApp.Workbooks.Open("C:\Database\Providence_20150604.xlsx")
    Set xlWorkSheet = xlWorkBook.Worksheets(1)

    With xlWorkSheet

        .Range("$Y$1").Value = strHeader

        With .Range("Y2:Y29").Validation
            .Delete
            .Add _
                    Type:=xlValidateList, _
                    AlertStyle:=xlValidAlertStop, _
                    Formula1:=strValueList
        End With
    End With


    'close down Excel:
    Set xlWorkSheet = Nothing

    xlWorkBook.Save
    xlWorkBook.Close
    Set xlWorkBook = Nothing

    xlApp.Quit
    Set xlApp = Nothing

    MsgBox "Ding!"

End Sub

Open in new window

Paul Cook-GilesSenior Application DeveloperAuthor Commented:
Norrie, thank you!  I've modified my code as follows;  it's blowing up on line 200 with "1004:  Application-defined or object-defined error".  (Specifically, it's blowing up on the .Add line.)   And could you explain what those Constants are doing?

Paul

Const xlValidateList = 2
Const xlValidAlertStop = 1


Public Sub InsertDropdownColumn(strFilename As String)
Dim strValueList As String, strHeader As String, intRowCount As Integer
Dim xlApp As Object, xlWorkBook As Object, xlWorkSheet As Object, strWorksheetName As String

strValueList = "Already Paid, Agree to Pay, Ineligible for Payment, More Info Needed, Other"
strHeader = "StatusFromCarrier"
intRowCount = DCount("*", "PendingExportTb") + 1

120       Set xlApp = CreateObject("Excel.Application")
130       Set xlWorkBook = xlApp.Workbooks.Open(strFilename)
140       Set xlWorkSheet = xlWorkBook.Worksheets(1)

150       With xlWorkSheet
160     .Range("$X$1").Value = "Status Comments"
170     .Range("$Y$1").Value = strHeader
180     With .Range("Y2:Y" & intRowCount).Validation
190         .Delete
200         .Add _
                    TYPE:=xlValidateList, _
                    AlertStyle:=xlValidAlertStop, _
                    Formula1:=strValueList
210     End With
220       End With

    'close down Excel:
230       Set xlWorkSheet = Nothing
240       xlWorkBook.Save
250       xlWorkBook.Close
260       Set xlWorkBook = Nothing
270       xlApp.Quit
280       Set xlApp = Nothing

End Sub

Open in new window

Paul Cook-GilesSenior Application DeveloperAuthor Commented:
I found a solution:


100   Do Until intRowNumber > intRowCount + 1 '(number of rows in export table plus 1 offset for header row)
   
110      With xlWorkSheet.Range("AC" & intRowNumber).Validation
120   .Delete
130   .Add _
   TYPE:=xlValidateList, _
   AlertStyle:=xlValidAlertStop, _
   Formula1:=strValueList
140   End With
   
150      intRowNumber = intRowNumber + 1
   
160   Loop

170   End With

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Paul Cook-GilesSenior Application DeveloperAuthor Commented:
Question was abandoned by Nonnie
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.