VBA to push data into a database - sql-server

Question

I have a data table that has just a few columns: GLID, Metric Category, Amount, and Metric Date. The way the data is organized on the excel file I need to use is like a matrix as so:
The date columns are the metric date and the numbers below them are the amounts. As you can see for each date there is some amount that pertains to a particular metric category and in some cases a GLID. Now what I need to do in VBA is push the data into the format as so
GLID Metric Category Amount Metric Date
5500 Property Tax-5500 -8 3/31/2020
5500 Property Tax-5500 -8 4/30/2020
So on and so forth. I am completely new to VBA so this particular task is daunting and challenging for me and thus why I made a post here. If anyone has some suggestions I would greatly appreciate it.
So far this is the setup I have in VBA:
Sub second_export()
Dim sSQL As String, sCnn As String, sServer As String
Dim db As Object, rs As Object
sServer = "CATHCART"
sCnn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Portfolio_Analytics;Data Source=" & sServer & ";" & _
"Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;"
Set db = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
If db.State = 0 Then db.Open sCnn
End Sub
Note For Further Clarification:
The number of columns is 36 and the number of rows is 46 in the excel file. For the categories that do not have a GLID then we can push NULL if needed.
I can push data into the database when its simply and insert but I have to pivot the data such that the GLID and Metric category are repeated for their associated dates and amounts.

Answer 1

First create a sheet of data to upload
Option Explicit
Sub CreateDataSheet()
Dim wb As Workbook, ws As Worksheet, wsData As Worksheet, header As Variant
Dim iLastRow, iLastCol, dt As Variant, iOutRow
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1") ' the matrix sheet
Set wsData = wb.Sheets("Sheet2") ' sheet to hold table data
wsData.Cells.Clear
wsData.Range("A1:D1") = Array("GLID", "Metric Category", "Amount", "Metric Date")
' get header
iLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
iLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
header = ws.Range(ws.Cells(1, 3), ws.Cells(1, iLastCol))
'Debug.Print iLastRow, iLastCol, UBound(header, 2)
Dim r, c
iOutRow = 2
For r = 2 To iLastRow
For c = 1 To UBound(header, 2)
'Debug.Print r, header(1, c), ws.Cells(r, c + 2)
With wsData.Cells(iOutRow, 1)
.Offset(0, 0) = ws.Cells(r, 1)
.Offset(0, 1) = ws.Cells(r, 2)
.Offset(0, 2) = ws.Cells(r, c + 2)
.Offset(0, 3) = header(1, c)
End With
iOutRow = iOutRow + 1
Next
Next
wsData.Range("A1").Select
MsgBox iOutRow - 2 & " Rows created on " & wsData.Name, vbInformation
End Sub
Then create a table in the database
Sub CreateTable()
Const TABLE_NAME = "dbo.GL_TEST"
Dim SQL As String, con As Object
SQL = "CREATE TABLE " & TABLE_NAME & "( " & vbCr & _
"RECNO int NOT NULL," & vbCr & _
"GLID nchar(10)," & vbCr & _
"METRICNAME nvarchar(255)," & vbCr & _
"AMOUNT money," & vbCr & _
"METRICDATE date," & vbCr & _
"PRIMARY KEY (RECNO))"
'Debug.Print sql
Set con = mydbConnect()
'con.Execute ("DROP TABLE " & TABLE_NAME) ' use during testing
con.Execute SQL
con.Close
Set con = Nothing
MsgBox "Table " & TABLE_NAME & " created"
End Sub
using data connection.
Function mydbConnect() As Object
Dim sConStr As String
Const sServer = "CATHCART"
sConStr = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;" & _
"Persist Security Info=True;" & _
"Initial Catalog=Portfolio_Analytics;" & _
"Data Source=" & sServer & ";" & _
"Use Procedure for Prepare=1;" & _
"Auto Translate=True;Packet Size=4096;"
Set mydbConnect = CreateObject("ADODB.Connection")
mydbConnect.Open sConStr
End Function
Then load the data from the sheet one record at a time with auto-commit off.
Sub LoadData()
Const TABLE_NAME = "dbo.GL_TEST"
Dim SQL As String
SQL = " INSERT INTO " & TABLE_NAME & _
" (RECNO,GLID,METRICNAME,AMOUNT,METRICDATE) VALUES (?,?,?,?,?) "
Dim con As Object, cmd As Object, rs As Variant
Set con = mydbConnect()
Set cmd = CreateObject("ADODB.Command")
With cmd
.ActiveConnection = con
.CommandType = adCmdText
.CommandText = SQL
.Parameters.Append .CreateParameter("P1", adInteger, adParamInput)
.Parameters.Append .CreateParameter("P2", adVarWChar, adParamInput, 10)
.Parameters.Append .CreateParameter("P3", adVarWChar, adParamInput, 255)
.Parameters.Append .CreateParameter("P4", adCurrency, adParamInput)
.Parameters.Append .CreateParameter("P5", adDate, adParamInput)
End With
con.Execute "SET IMPLICIT_TRANSACTIONS ON"
Dim ws As Worksheet, iLastRow As Long, i As Long
Set ws = ThisWorkbook.Sheets("Sheet2") ' sheet were table data is
iLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To iLastRow
cmd.Parameters(0).Value = i
cmd.Parameters(1).Value = ws.Cells(i, 1)
cmd.Parameters(2).Value = ws.Cells(i, 2)
cmd.Parameters(3).Value = ws.Cells(i, 3)
cmd.Parameters(4).Value = ws.Cells(i, 4)
cmd.Execute
Next
con.Execute "COMMIT"
con.Execute "SET IMPLICIT_TRANSACTIONS OFF"
rs = con.Execute("SELECT COUNT(*) FROM " & TABLE_NAME)
MsgBox rs(0) & " Rows are in " & TABLE_NAME, vbInformation
con.Close
Set con = Nothing
End Sub

Answer 2

Here's how you can loop over your data:
Sub Tester()
Dim rw As Range, n As Long
Dim GLID, category, dt, amount
For Each rw In ActiveSheet.Range("H2:AS47").Rows
'fixed per-row
GLID = Trim(rw.Cells(1).Value)
category = Trim(rw.Cells(2).Value)
'loopover the date columns
For n = 3 To rw.Cells.Count
dt = rw.Cells(n).EntireColumn.Cells(1).Value 'date from Row 1
amount = rw.Cells(n).Value
Debug.Print rw.Cells(n).Address, GLID, category, amount, dt
'insert a record using your 4 values
'switch GLID to null if empty
Next n
Next rw
End Sub