Add Data To Excel From 2 Sources

[Welshgasman]

Where are you formatting that field as a pecent?


In the table or just in Excel?

Remove the formatting and show what is being stored.

[DMT Dave]

Hi WGM, just in Excel but this gives the correct figure now:

curNewPrice = curDiff / 4 + curOldPrice

Price Difference / 4 (to give me 25% of the difference)

Price Diff / 4 + currentprice, i don't know why i went round in circles with it, was easy as that

[Welshgasman]

Probably because you were dividing by 100 when it was already divided by 100 ?

That is why I wanted to see what the value actually was, not the formatted/obscured version.

Again, if you walked your code and inspected the variable/field values you would know/find that. However that is something you never seem to want to do, so you make everything so much harder for yoursel?

[DMT Dave]

Hi Guy's just to finish this, while i have cells 2,19 highlighted, how can i highlight every quarter (See red text)

How do i highlight the same column (19) but every quarter ?

Dim pOpen As String, fOpen As String, sPercDiff As String, sPercDiffQ As String, strMonth As String, strOldPrice As String, strNewSheet As StringDim intLR As Integer, iYear As Integer, iQuarter As Integer, iMonth As Integer
Dim rs As DAO.Recordset
Dim dtDate As Date, dtDateTo As Date
Dim apXL As Object, xlWB As Excel.Workbook, xlWS As Excel.Worksheet, ws1 As Excel.Worksheet, wsNew As Excel.Worksheet, wsExists As Excel.Workbooks
Dim cPrice As Currency, cDiff As Currency, curOldPrice As Currency, curNewPrice As Currency
Dim varNewPrice As Variant
Dim blSheet As Boolean


pOpen = "T:\DMT Ltd\Fuel Price Sheets\"
fOpen = "Fuel Index.xlsx"


    'NEW SHEET NAME
    strNewSheet = "Prices " & Format(Now(), "dd-mm-yyyy-hh-nn")
    
    Set apXL = CreateObject("Excel.Application")
    Set xlWB = apXL.Workbooks.Open(pOpen & fOpen)
    'ADD NEW SHEET AFTER LAST SHEET
    With xlWB
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = strNewSheet
    End With
    'OPEN THE NEW NAMED WORKSHEET
    Set xlWS = xlWB.Worksheets(strNewSheet)
    
    Set ws1 = xlWB.Worksheets("Sheet1")
    Set wsNew = xlWB.Worksheets(strNewSheet)
        'COPY ORG SHEET
        ws1.Cells.Copy
        
        With wsNew.Cells
            .PasteSpecial Paste:=xlPasteColumnWidths
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
        End With
        
        Set rs = CurrentDb.OpenRecordset("Select * From qryFuelPriceUpdate")
'SET DB RECORDSET
'SET XLWKSHT
    With xlWS
'FIND LAST ROW USED
        intLR = .Cells(.Rows.Count, 1).End(xlUp).Row
'START RECORDSET
        Do Until rs.EOF
'SET VARIABLES FROM RS FIELDS
            dtDate = rs.Fields("MonthStart")
            iYear = rs.Fields("FuelYear")
            iQuarter = rs.Fields("FuelQuarter")
            strMonth = rs.Fields("FuelMonth")
            cPrice = Format(rs.Fields("FuelPrice"), "Currency")
            cDiff = Format(rs.Fields("Difference"), "Currency")
            sPercDiff = Format(rs.Fields("PercentageDiff"), "00.00%")
            sPercDiffQ = Format(rs.Fields("Perentage25"), "00.00%")
            dtDateTo = DateAdd("m", 1, dtDate)
            curOldPrice = Format(rs.Fields("Nett"), "Currency")
            varNewPrice = rs.Fields("Nett") + (rs.Fields("Nett") * rs.Fields("Perentage25") / 100)
            curNewPrice = curDiff / 4 + curOldPrice
            
'SET WHICH EXCEL CELLS FOR DATA
        xlWS.Cells(intLR + 1, 1) = dtDate
        xlWS.Cells(intLR + 1, 3) = iYear
        xlWS.Cells(intLR + 1, 5) = iQuarter
        xlWS.Cells(intLR + 1, 7) = strMonth
        xlWS.Cells(intLR + 1, 9) = cPrice
        xlWS.Cells(intLR + 1, 11) = cDiff
        xlWS.Cells(intLR + 1, 13) = sPercDiff
        xlWS.Cells(intLR + 1, 15) = sPercDiffQ
        xlWS.Cells(intLR + 1, 17) = curOldPrice
        xlWS.Cells(intLR + 1, 19) = rs.Fields("Difference") / 4 + rs.Fields("Nett")


        xlWS.Cells.EntireColumn.AutoFit
        xlWS.Cells.EntireColumn.HorizontalAlignment = xlLeft
'HIGHLIGHT CELL ROW 2 COLUMN 19 'HOW DO I HIGHLIGHT EVERY QUARTER IN ROW 19 ?
        xlWS.Cells(2, 19).Interior.ColorIndex = 6
'MOVE THROUGH RECORDSET
        rs.MoveNext
'NOW SET NEW EMPTY CELLS (LAST ROW PLUS 1)
        intLR = intLR + 1
'NOW LOOP THE RECORDSET
        Loop
        
   End With
'CLOSE AND SAVE THE XL FILE
        xlWB.Save
        xlWB.Close
        apXL.Quit


        Set rs = Nothing
        
'CONFIRM PROCEDURE COMPLETED


    MsgBox ("All Data Has Been Transferred"), vbInformation + vbOKOnly, "PROCEDURE COMPLETE"