Excel macro to move data across workbooks using an ADO connection

Question

I am writing a macro to move data from a CSV to an excel template. Currently, I have the code set to search for a keyword in column A of the CSV, and extract data from specified columns in the keywords row. I would like to know if there is something I can do to simplify the code.

Public Sub MoveData()


    '**defines the project name as a variable
    Dim fileName As String
        fileName = Worksheets("Cover").Range("B5").Value

    '**defines the path of the CSV summary from BlueBeam
    Dim path As String
        path = "C:\Users\(users)\Documents\(folder)\" & fileName & ".csv"

    '**defines the two workbooks that the data will move between
    Dim currentWB As Workbook
    Set currentWB = ThisWorkbook

    Dim openWB As Workbook
    Set openWB = Workbooks.Open(path)

    Dim openWs As Worksheet
    Set openWs = openWB.Sheets(fileName)

    '**connects using ADODB to transfer the data
    Dim cn As ADODB.Connection                      
    Set cn = New ADODB.Connection                   
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & path & ";" & _
    "Extended Properties=Excel 12.0 Xml;"
        .Open
    End With

    '**selects the first column to be read and sorted
    Dim subCell As Range
    Dim myRange As Range
    Set myRange = Range("A1:A500")

    Dim cmdOpen1 As Boolean
    cmdOpen1 = False
    Dim cmdOpen2 As Boolean
    cmdOpen2 = False


    For Each subCell In myRange

        If subCell Like "*keyword1*" Then



            strQuery = "SELECT [Measurement] FROM [" & fileName & "$] Where Subject = '" & subCell.Value & "'"

            Set cmd1 = New ADODB.Command
            With cmd1
                .ActiveConnection = cn
                .CommandText = strQuery
            End With

        Dim rst1 As New ADODB.Recordset
            With rst1
                If cmdOpen1 = False Then
                    .Open cmd1
                    cmdOpen1 = True
                End If
            End With

            currentWB.Worksheets("Bms").Range("C7").CopyFromRecordset rst1




        ElseIf subCell Like "*keyword2*" Then



            strQuery = "SELECT [Notes (C)], [Col Top (C)], [Col Base (C)] FROM [" & fileName & "$] Where Subject = '" & subCell.Value & "'"

            Set cmd2 = New ADODB.Command
            With cmd2
                .ActiveConnection = cn
                .CommandText = strQuery
            End With


            Dim rst2 As New ADODB.Recordset
            With rst2
                If cmdOpen2 = False Then
                    .Open cmd2
                    cmdOpen2 = True
                End If
            End With

            currentWB.Worksheets("Cols").Range("B7").CopyFromRecordset rst2

        End If

    Next subCell
    openWB.Close

rst1.Close
rst2.Close
End Sub

I'm fairly new to VBA and extremely new to recordsets, so please let me know if you notice anything that should be changed. In total, I will be writing the code to search for about 6-7 keywords and the columns that the data will change based on the keyword. I'd like to revise this code before I move forward with adding more data selection.

If you need anymore information on what I am trying to accomplish or how I coded an area, please let me know. Any help will be greatly appreciated.

Answer 1

The first thing is that you do not seem to be using Option Explicit because there are some variables (strQuery, cmd1 and cmd2) that are not declared. You should always use Option Explicit and this can be turned on in Tools -> Options, on the Editor tab check the "Require Variable Declaration" checkbox. The IDE will add Option Explicit at the top of every new module.

You are currently mixing the "standard" Excel data access methods (cells, ranges, etc) with using sql which makes it harder to keep track of what your code is doing. This can be simplified by using just sql to get data from the csv file. You don't need to read down through the csv file looking for keywords, you can include the keyword in your sql with a WHERE clause. This also means you do not need to open the csv file. In sql the % character is the wildcard for zero or many characters.

If you are retrieving data using ADODB, then you only need to use Recordset, you don't need to use a Command object and a Recordset. If you will be repeatedly opening a recordset and copying the data to a range then you could put that code into a separate procedure. In my code below, I have the CopyFromFileToRange procedure.

Some of your variable names are good but some are too short/unclear (cn, rst1 and cmd) and strQuery looks like you might be thinking of using Hungarian notation. See this post for a discussion of Hungarian. The main thing is to be consistent in your choice/style.

Option Explicit

Public Sub MoveData()

    '**defines the project name as a variable
    Dim fileName As String
        fileName = Worksheets("Cover").Range("B5").Value

    '**defines the path of the CSV summary from BlueBeam
    Dim filePath As String
        filePath = "C:\Users\(users)\Documents\(folder)\"

    '**defines the destination workbook
    Dim currentWB As Workbook
    Set currentWB = ThisWorkbook

    '**connects using ADODB to transfer the data
    Dim dbConn As ADODB.Connection
    Set dbConn = New ADODB.Connection

    With dbConn
        .ConnectionString = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & filePath _
            & ";Extensions=asc,csv,tab,txt;"
        .Open
    End With

' Added declarations
Dim measurementQueryString As String
Dim notesQueryString As String
Dim keyword1 As String
Dim keyword2 As String

    keyword1 = "some_value"
    measurementQueryString = "SELECT [Measurement] FROM [" & fileName & "] " _
        & "Where Subject LIKE '%" & keyword1 & "%';"
    Call CopyFromFileToRange(dbConn, measurementQueryString, currentWB.Worksheets("Bms").Range("C7"))

    keyword2 = "some_value"
    notesQueryString = "SELECT [Notes (C)], [Col Top (C)], [Col Base (C)] FROM [" & fileName & "] " _
        & "Where Subject LIKE '%" & keyword2 & "%'"
    Call CopyFromFileToRange(dbConn, notesQueryString, currentWB.Worksheets("Cols").Range("B7"))

    dbConn.Close

End Sub

Private Sub CopyFromFileToRange(ByRef dbConn As ADODB.Connection, ByRef queryString As String, ByRef targetRange As Range)

' Opens a recordset using queryString as the source
' Writes the data to targetRange

Dim dataFromCsv As ADODB.Recordset

    Set dataFromCsv = New ADODB.Recordset
    dataFromCsv.Open Source:=queryString, ActiveConnection:=dbConn
    If Not dataFromCsv.EOF Then
        targetRange.CopyFromRecordset dataFromCsv
    Else
        ' No data found
    End If

    dataFromCsv.Close

End Sub