Excel: continuously log database data into cells

[mewingpants]

Sorry if this has been asked before but I am not quite sure how to word it to search for the solution exactly.

So I am currently using this vba code to import information from my database and update in my Excel sheet every 15 minutes.

Sub Workbook_Open()

Dim SQL_String As String
Dim dbConnectStr As String
Set con = New ADODB.Connection
Set recset = New ADODB.Recordset
Dim cmd As ADODB.Command
Dim row As Integer


dbConnectStr = "Provider=SQLOLEDB;Data Source=mydatabase;User Id=myid;Password=mypassword;"
con.ConnectionString = dbConnectStr
con.Open dbConnectStr
SQL_String = Sheets("qry").Range("C2").Value

recset.Open SQL_String, con
Sheets("data").Cells.Clear
Sheets("data").Range("A1") = "Tank"
Sheets("data").Range("B1") = "Entry Date"
Sheets("data").Range("C1") = "Product"
Sheets("data").Range("D1") = "Product Level"
Sheets("data").Range("E1") = "Product Temperature"

Sheets("data").Range("A1:P1").Font.Bold = True

Sheets("data").Activate
row = 1

Do Until recset.EOF = True
row = row + 1
Sheets("data").Range("A" & row) = recset!Tank
Sheets("data").Range("B" & row) = recset!Entry_date
Sheets("data").Range("B" & row).NumberFormat = "mm/dd/yy HH:mm"
Sheets("data").Range("C" & row) = recset!Product
Sheets("data").Range("D" & row) = recset!Product_Level
Sheets("data").Range("E" & row) = recset!Product_Temperature


recset.MoveNext
Loop
Sheets("data").Columns("A:P").AutoFit
recset.Close
con.Close

End Sub


It works great BUT I was wondering what would I need to change to continuously store the data in cells, instead of the cells being overwritten with the most recent time?

Something like this:

TANK TIME PRODUCT LEVEL TEMP
1 6:15 Gas 10' 70
1 6:30 Gas 12' 70
1 6:45 Gas 14' 71
1 7:00 Gas 16' 71



Thanks for any advice.

 

[DacEasy]

Hi, I took a look at the code and here is what I think:

It appears the sheet clears every time it starts. Try changing Sheets("data").Cells.Clear to 'Sheets("data").Cells.Clear, so that it skips process. Also, row needs to go to the last row, so that it keeps adding. Plus, row now needs to be Long vs Integer since the spreadsheet size will grow. I hope this helps. See Below:

'change Dim row As Integer to 
Dim row as Long

'change Sheets("data").Cells.Clear to 'Sheets("data").Cells.Clear
'Sheets("data").Cells.Clear

'change row = 1 to row = Cells(Rows.Count, 1).End(xlUp).Row 
row = Cells(Rows.Count, 1).End(xlUp).Row

 

[mewingpants]

Thank you! worked perfectly