• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Only want the new data to be parsed

K

Kellan Adamson

New Member
Been working on a macro that imports data from a SQL database, then copies the data to sheets depending on what value is in column R (1-4).

Column B contains the transaction # which increases by 1 for each transaction. Cell AA1 uses =MAX(B:B) to get the highest # in that column and then copies the value to AA2 for later use. I use that value to only import data from SQL that is greater than AA2.

Now here is where I hit my issue.

I can't figure out how to get the parsing section to only copy the newest data to the numbered sheets when I run the macro a second time. I'm guessing the solution would be an if statement somewhere that uses AA2 as the starting point for the parsing section but I'm lost with how to implement it.

Any ideas?

Code: 
Sub Download_and_Parse()

Sheets("Import").Range("AA1").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-25])"
Range("AA1").Select
Selection.Copy
Range("AA2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Initializes variables
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim ConnectionString As String
Dim StrQuery As String

'Setup the connection string for accessing MS SQL database
  'Make sure to change:
      '1: PASSWORD
      '2: USERNAME
      '3: REMOTE_IP_ADDRESS
      '4: DATABASE
    ConnectionString = "Provider=SQLOLEDB.1;Password=;Persist Security Info=True;User ID=;Data Source=;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False;Initial Catalog=WINFUEL"

'Opens connection to the database
    cnn.Open ConnectionString
'Timeout error in seconds for executing the entire query; this will run for 15 minutes before VBA timesout, but your database might timeout before this value
    cnn.CommandTimeout = 900

'This is your actual MS SQL query that you need to run; you should check this query first using a more robust SQL editor (such as HeidiSQL) to ensure your query is valid
    StrQuery = "SELECT * FROM [ASI].[ExportView] WHERE SequenceNumber > " & Sheets("Import").Range("AA1").Value

'Performs the actual query
    rst.Open StrQuery, cnn
   
'Dumps all the results from the StrQuery into cell A2 of the first sheet in the active workbook
    Sheets(1).Range("A2").CopyFromRecordset rst

'Adds headings to IMPORT sheet
    Sheets("Import").Activate
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Site #"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Sequence #"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Fill Capacity"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Litres"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Fuel Cost per Unit"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Fuel Cost Total"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Description 2"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Description"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Division Name"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Credit Limit"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Credit Remaining"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "FOB Limit"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "User PIN"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "User Name"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Driver Division #"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "All Divisions?"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Division #"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "FOB #"
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "Pump #"
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "Tank #"
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "Fuel Name"
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "Fuel Type #"
    Range("X1").Select
    ActiveCell.FormulaR1C1 = "Marked as Exported?"
    Range("Y1").Select
    ActiveCell.FormulaR1C1 = "ODO/RO #"
   
'Hides unnecessary columns
    Columns("A:A").Select
    Selection.EntireColumn.Hidden = True
    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    Columns("G:G").Select
    Selection.EntireColumn.Hidden = True
    Columns("K:L").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:R").Select
    Selection.EntireColumn.Hidden = True
    Columns("T:U").Select
    Selection.EntireColumn.Hidden = True
    Columns("W:W").Select
    Selection.EntireColumn.Hidden = True
    Columns("X:X").Select
    Selection.EntireColumn.Hidden = True
   
'Initializes variables
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 18
Set ws = ActiveSheet

'Hides columns in numbered sheets
ws.Columns("A:A").EntireColumn.Hidden = True
ws.Columns("E:E").EntireColumn.Hidden = True
ws.Columns("F:F").EntireColumn.Hidden = True
ws.Columns("G:G").EntireColumn.Hidden = True
ws.Columns("K:K").EntireColumn.Hidden = True
ws.Columns("L:L").EntireColumn.Hidden = True
ws.Columns("P:P").EntireColumn.Hidden = True
ws.Columns("Q:Q").EntireColumn.Hidden = True
ws.Columns("T:T").EntireColumn.Hidden = True

'Copies data into sheets named for the unique data in column R
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:R1"
titlerow = ws.Range(title).Cells(18).Row
icol = ws.Columns.Count
ws.Cells(18, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter Field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!R1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A1" & ":R1").EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
ws.Range("A" & titlerow + 1 & ":R" & lr + 1).EntireRow.Copy Sheets(myarr(i) & "").Range("A1000000").End(xlUp).Offset(1, 0)
'Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate

'Creates totals per service vehicle on sheet 2
Sheets(2).Activate
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Van"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "Total"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "R18"
    Range("P3").Select
    ActiveCell.FormulaR1C1 = "R54"
    Range("P4").Select
    ActiveCell.FormulaR1C1 = "R55"
    Range("P5").Select
    ActiveCell.FormulaR1C1 = "R56"
    Range("P6").Select
    ActiveCell.FormulaR1C1 = "R57"
    Range("P7").Select
    ActiveCell.FormulaR1C1 = "R58"
    Range("P8").Select
    ActiveCell.FormulaR1C1 = "R59"
    Range("P9").Select
    ActiveCell.FormulaR1C1 = "R60"
    Range("P10").Select
    ActiveCell.FormulaR1C1 = "R61"
    Range("P11").Select
    ActiveCell.FormulaR1C1 = "R62"
    Range("P12").Select
    ActiveCell.FormulaR1C1 = "R63"
    Range("P13").Select
    ActiveCell.FormulaR1C1 = "R64"
    Range("P14").Select
    ActiveCell.FormulaR1C1 = "R65"
    Range("P15").Select
    ActiveCell.FormulaR1C1 = "R66"
    Range("P16").Select
    ActiveCell.FormulaR1C1 = "R67"
    Range("P17").Select
    ActiveCell.FormulaR1C1 = "R68"
    Range("P18").Select
    ActiveCell.FormulaR1C1 = "R69"
    Range("P19").Select
    ActiveCell.FormulaR1C1 = "R70"
    Range("P20").Select
    ActiveCell.FormulaR1C1 = "R71"
    Range("P21").Select
    ActiveCell.FormulaR1C1 = "R72"
    Range("P22").Select
    ActiveCell.FormulaR1C1 = "R73"
    Range("P23").Select
    ActiveCell.FormulaR1C1 = "Shunt 1"
    Range("P24").Select
    ActiveCell.FormulaR1C1 = "Shunt 2"
    Range("P1:Q1").Select
    Selection.Style = "Heading 2"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=SUMIF(C[-12],""=""&RC[-1],C[-14])"
    Range("Q2").Select
    Selection.AutoFill Destination:=Range("Q2:Q24"), Type:=xlFillDefault
    Range("Q2:Q24").Select
    Sheets("IMPORT").Select
    Range("AA1").Select
    Selection.ClearContents
    Range("AA2").Select
    Selection.ClearContents
    Sheets("1").Select
    Range("N1").Select
    Selection.ClearContents
    Sheets("2").Select
    Range("N1").Select
    Selection.ClearContents
    Sheets("3").Select
    Range("N1").Select
    Selection.ClearContents
    Sheets("4").Select
    Range("N1").Select
    Selection.ClearContents
End Sub
 
I would think something along the lines of
Dim MaxID As Long
MaxID = WorksheetFunction.Max(Sheets("PARSEDSHEETNAME").Range("Aa:Aa"))

That, across all the parsed sheets, and you get the max ID from that (last transaction that was already processed) and then you know where to start off from. Modify the parse arguments then to start not at row 1 or 2, but at the MaxID. Probably takes a bit of playing around with it.

You might just want to insert a formula to get the max across all sheets, and refer the VBA to that value, otherwise, take a look at this code for how to get VBA to get a max across multiple sheets (seems a little big!)
https://stackoverflow.com/questions...different-sheets-and-report-it-in-result-shee
 
Thankfully I have AA2 as the max value which is calculated in AA1 and then the value is copied to AA2 to keep it static. I can use that across all sheets if necessary.

I have been trying to play with this but not getting anywhere. I think I have confused myself more than anything.
 
Try modifying this line
Code: 
titlerow = ws.Range(title).Cells(18).Row

to

Code: 
titlerow = ws.Range("AA2").value+1


That should then start parsing at the row number specified in cell AA2, add 1 to account for the 1 row heading. Just see that your data still makes sense.
 
YOU ARE A DAMNED MIRACLE WORKER!!! That seems to work!!!!!!!!!!!!!

One thing though....riddle me this. Why after changing that line is it now copying the title row twice? So now I have my headings in row A and B on the 4 numbered sheets. Really, it doesn't matter as I an just delete the headings as part of the macro but I'm just curious as to what is happening.
 
Actually, small error, scrap the +1 it already looked one lower anyway. But I would suggest that when you run it, take a look at the items near the cut off ensure they're all there.

Well this is the macro, it doesn't double up the headings for me so idk must be another part of what you added? Delete the extra headings row, run macro see if this comes back? BTW, you can open the VBA code and hit F8 it will take you step by step, so you should see when your extra heading row is inserted.
 

Attachments

  • Copy of Parse.xlsm
    25.1 KB · Views: 5
It works beautifully except that it repeats the last transaction.

BTW Seeing if I can step through it to find out where it's creating the second set of headers. If I remove them after the first time I run it, they don't come back so that's a plus.
 
Nope. Spoke too soon. Thought it was working but if I add the + 1 it just starts duplicating the entire parsing process instead of just the last line like it was before.

Almost there.
 
Regarding your headings, i suspect you had them copy accidentally and then it was treated as a row of data.i can't see why it would double the headings, the headings are there from your 'title' pasting to range A1:R1

Re your qs. Yes it's the titlerow. Maybe it's your data? The assumption there is that your transactions start at no. 1 in row 2 and increase on in an organised fashion. 1, 2, 3. So if any data is in a different order or if any transaction id is different, blank, hidden, we need to fix the code.
 
For sure isn't the data. That one column for transaction # cannot have any duplicates and can only increase by 1 and will never be lower than the previous number. Data is produced by our fueling system so there is no way I can change the transaction # even if I wanted to.

At least it isn't duplicating the entire section anymore and just the last transaction. So lets say the last transaction # is 607. If I run it multiple times and there is no new data, it will just parse the last transaction over and over. so I will have 607 repeated. Does NOT add it to the import sheet over and over though.

I think you are absolutely right about the headings. They are getting treated as data.
 
I gotta say I can't see this happening for my dummy data (the last transaction)

If your dataset is up to date, your AA2 value is the same as your import tab C:C max value, right?

If you're really struggling, you can just have it check for update and exit procedure if sheet is up to date. make AA2 say "Imported" if max in import C:C is equal to max across all the export tabs. Otherwise give the max of other tabs (last parsed transaction)

Insert this code wherever you want the macro to stop. Might want to declare the sheet there if your macro isn't running with import tab active.

Code: 
'exit sub if data was already parsed
If Range("AA2").Value = "Imported" Then
Exit Sub
End If
 
You must log in or register to reply here.
Back
Top