Dynamic Columns in MS Query

Jeff commented that he wants to bring in the latest x columns in from spreadsheet using MS Query, where x is some number. The columns are expanding, so he doesn’t always know what the latest will be.

I started with this example spreadsheet

Note that the “date” headers aren’t really dates but strings (they have a single quote in front of them). When they were regular dates, instead of bringing those column headers, it would bring headers like F1, F2, etc, so I made them strings.

The following code uses ActiveX Data Objects (you have to set a reference under Tools – References) to bring in all of the columns. Then using the Field names, it constructs a new SQL statement using only the desired columns. In this example, I only bring in Category and the last two columns from the sheet.

Sub DynamicColumns()
   
    Dim adCn As ADODB.Connection
    Dim adRs As ADODB.Recordset
    Dim sCon As String
    Dim sSql As String
    Dim i As Long
   
    Const lLAST As Long = 2
   
    ‘Get the whole table
   ‘Note the accent graves and double-double quotes
   sCon = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & _
        “C:Documents and SettingsdickMy DocumentsTestAdo.xls;” & _
        “Extended Properties=”“Excel 8.0;HDR=Yes;IMEX=1”“;”
    sSql = “SELECT * FROM ‘Sheet1$’;”
   
    Set adCn = New ADODB.Connection
    adCn.Open sCon
    Set adRs = adCn.Execute(sSql)
   
    ‘Build new sql string, again with the accent graves
   sSql = “SELECT Category, “
    For i = (adRs.Fields.Count – lLAST) To (adRs.Fields.Count – 1)
        sSql = sSql & “‘” & adRs.Fields(i).Name & “‘, “
    Next i
    sSql = Left$(sSql, Len(sSql) – 2)
    sSql = sSql & ” FROM ‘Sheet1$’;”
   
    adRs.Close ‘close the whole table recordset
   
    Set adRs = adCn.Execute(sSql) ‘open the new rs
   
    ‘copy it to the worksheet (no headers)
   Sheet1.Range(“a1”).CopyFromRecordset adRs
   
    adRs.Close
    adCn.Close
   
    Set adRs = Nothing: Set adCn = Nothing
   
End Sub

And the result

Posted in Uncategorized

11 thoughts on “Dynamic Columns in MS Query

  1. Hi Dick. THanks for taking the time to answer my query. Question for you…can you elaborate on the bit where you say that regarding ActiveX Data Objects “you have to set a reference under Tools – References”.

    I’m not quite sure what this entails. Here’s a screenshot of the relevent VBA window: http://screencast.com/t/NTQzOWQy

  2. On a punt, I chose Microsoft ActiveX Data Object 2.0 Library. Now the code works, with the exception that – as in the example above – it doesn’t bring the column headers through. Any ideas what I need to add to do that?

  3. Ahh..just found the relevent bit I needed in J-Walk’s power programming.

    Dim Col As Integer

    ‘write the field names
    For Col = 0 To adRs.Fields.Count – 1
    Sheet1.Range(“a1?).Offset(1, Col).Value = _
    adRs.Fields(Col).Name
    Next

    ‘copy it to the worksheet (no headers)
    Sheet1.Range(“a1?).Offset(1, 0).CopyFromRecordset adRs

    Excellent. Thanks for posting this Dick. You’ve taught a man to fish…

  4. Dick;
    You had a comment line: “Note the accent graves and double-double quotes’

    Showing some real ignorance here but I gotta ask: what are accent graves?

  5. Hi all. Dick…regarding your comment Note that the “date” headers aren’t really dates but strings (they have a single quote in front of them). When they were regular dates, instead of bringing those column headers, it would bring headers like F1, F2, etc, so I made them strings.

    My date formatting comes through fine when I set up a query vie MS Query, but when I run your code I lose the date formatting. I turned on the Macro Recorder and recorded how Excel handles setting up a new connection, and noticed that the code included .PreserveFormatting = True

    Could this be the issue causing your date headers to screw up?

    Here’s what I got from the macro recorder (with the exception that I changed the very long select list to SELECT * )

    Sub Set_up_Query()

    ‘ Set_up_Query Macro


        With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
            “ODBC;DSN=Excel Files;DBQ=J:MON 04 DataStatistics New ZealandHLFSLfstrd.xls;DefaultDir=J:MON 04 DataStatistics New ZealandHLFS” _
            ), Array(“;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;”)), Destination:= _
            Range(“$A$1”)).QueryTable
            .CommandText = Array( _
            “SELECT *” & Chr(13) & “” & Chr(10) & “FROM ‘J:MON 04 DataStatistics New ZealandHLFSLfstrd.xls’.’HLFS$’ ‘HLFS$'” _
            )
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
            .ListObject.DisplayName = “Table_Query_from_Excel_Files”
            .Refresh BackgroundQuery:=False
        End With
    End Sub

  6. Hi,

    I need to assign a macro in excel for the sum of invoice amount for a desired value.

    Eg:- column C1 shows 100.00 and i do have invoice amount for 20.00, 30.00, 40.00, 100.00, 10.00, 90.00 in column “A”. I want to show the combination of the invoice amount in next spreadsheet for the total of invoice amount which equal to 100.00 specified in C1.

    Thanks in advance.
    S.Prashanth

  7. Hi Tushar Mehta,

    Thanks for the update.

    Please find below the list how i used to calculate the value for the desired amount.

    ABC
    120100.00
    230
    340
    440
    510
    690

    If i run a macro the amount mentioned in column A has to find the combination of the desired matching amount for amount 100.00 mentioned in column C1.

    Hope this helps you, please advise me how to assign the macro as i used to do manually everyday on the above.

    Thanks & regards
    S.Prashanth


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.