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.
1 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.
enter image description here
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