HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Excel macro to move data across workbooks using an ADO connection

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
workbooksexceladomovemacrousingacrossdataconnection

Problem

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

Solution

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

Code Snippets

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

Context

StackExchange Code Review Q#95977, answer score: 4

Revisions (0)

No revisions yet.