Copy To XL Rows

[DMT Dave]

Hi Guys, I have a recordset arranged by Access field xlRow

Set rs10 = CurrentDb.OpenRecordset("SELECT tblAssign.DelTo, tblAssign.Town, tblAssign.SONumber, tblAssign.PONumber, tblAssign.ProductType, tblAssign.ProductNo, tblAssign.Status, tblAssign.xlRow FROM tblAssign WHERE Customer = '" & Cust & "'" & " And Source = '" & Src & "'" & " And ProductType = '" & FL & "'" & " And DeliveryDate = #" & MyDate & "#" & " ORDER BY xlRow;")

I am outputting to a new Excel File for copy and paste so that the update is on the correct Excel rows



If for example there are 14 rows on the Excel File and i need to update rows 1-9 (not 10 or not 11) but 12,13 and 14

Although my field in access called xlRow will have 1-9, 12,13 and 14 in there, when i output, how can i skip rows 10 and 11 so there is the gap on the Excel sheet at rows 10 and 11 to copy and paste ?

hope this makes sense ??

With regards

[pbaldy]

So the xlRow field contains the row? You'll need to use automation to open and edit the excel file using that for the row. See if this helps, though it has more than you need:

https://www.devhut.net/2016/07/07/vba-automating-excel/

[DMT Dave]

Hi pbaldy, thank you for your reply, yes we have matching data on Access to a row on Excel, however if 112 is row 10 on excel, 112 on Access xlRow field is 10, I think I am struggling with getting the recordset to out put data to specific row number (10), the xlRow is manually input to database

So for example db data
Name = John
Date = 4/1/19
Shipped = "Yes"
xlRow = 18

Excel Data
Name = John (on Row 18) Column a

Date = 4/1/19 (on row 18) Column b

Shipped = "" add from recordset where name = john and date = 4/1/19 ?? (needs to add Yes to row 18 on Excel
xlRow = 18

will check out your link

Many thanks

[pbaldy]

With automation you can use your row field to determine which row in Excel is affected. Post back if you get stuck.

[DMT Dave]

Hi pbaldy, i am setting the recordset order by xlRow;

I think i will add my code here in the morning as my initial plan was to update a set of records instead of one at a time to the correct Excel rows..

another method but a bit messy is open excel file visible false after each record update and place the dates in the relevant rows but if there is 30 date records in one day then it's opening and closing the Excel file 30 times!

If i can get the recordset to do it, then Excel opens and closes once

Do i put hash before and after code ?

Kind regards

[pbaldy]

I'm not clear what hash you're referring to. The ones around the date field in the SQL appear to be correct. You should be able to open the Excel file once and edit the appropriate rows.

[DMT Dave]

do i not use hash to place code on here is what i was referring to so you can see the code here ?

Kindest

[pbaldy]

Oh yes. It's not required but it preserves indenting. It will put code tags into the reply, put your code between them. The tags are [ CODE] and [ /CODE] without the spaces.

[accesstos]

To define the cell that have to update, you can use the value of [xlRow] field for the row and the OrdinalPosition property of each field for the column, like that:

                    '~~~to the nitty-gritty~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                    With WB.Sheets(1).Range("A1")
                        While Not rs.EOF
                            For Each Fld In rs.Fields
                                .Offset(rs![xlRow], Fld.OrdinalPosition) = Fld
                            Next Fld
                            rs.MoveNext
                        Wend
                    End With
                    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Good continuing!

[DMT Dave]

Hi Thank you so much for this accesstos

So this is the worksheet that requires the the updates in the correct Excel rows from Column K10, is this the way based on your reply ? (everything above K10 is the customers headers and instructions), K10 is our column to update, just hoping below would determine the correct row from access xlRow field ???

Also do i have this in the correct area or does it need to be after setting other cells ???????

'.Worksheets(8).Range ("K10")
'While Not rs8.EOF
'For Each fld In rs8.Fields
'.Offset(rs![xlRow], fld.OrdinalPostition) = fld
'Next fld
'rs8.MoveNext
'Wend
.Worksheets(8).Cells(1, 3) = "MANUF NO"
.Worksheets(8).Cells(1, 4) = "SL-NUMBER"
.Worksheets(8).Cells(1, 5) = "PARTNER"
.Worksheets(8).Cells(1, 6) = "PRODUCT TYPE"
.Worksheets(8).Cells(1, 7) = "PO-NUMBER"
.Worksheets(8).Cells(1, 8) = "SHIPPED"
.Worksheets(8).Cells(1, 9) = "DELIVERY DATE"
.Worksheets(8).Cells(1, 10) = "ON LINE XL ROW NO"
.Worksheets(8).Cells(6, 3).CopyFromRecordset rs8
.Worksheets(8).Range("C3:J3").Borders(xlEdgeTop).L ineStyle = xlContinuous
.Worksheets(8).Cells.EntireColumn.AutoFit
.Worksheets(8).Cells.EntireColumn.HorizontalAlignm ent = xlLeft
.Save
xlWB.Close
ApXL.Quit
Set ApXL = Nothing
End With'

[pbaldy]

CopyFromRecordset won't work, as it won't respect your row numbers. You'd loop the recordset and have lines like:

.Worksheets(8).Cells(rs8!xlRow, 3) = rs8!FieldName

[accesstos]

You are welcome Dave!

Ι agree with Paul about CopyFromRecordset. It will make updates in a compact area with x rows and y columns, without gap rows as you want.
I thing that the function bellow is very close to what you asking for.

Function UpdateExcel(ByVal strSQL As String, _
                     ByVal strTargetWB As String, _
                     ByVal strTargetCell As String) As Boolean
    Dim XL As Excel.Application
    Dim WB As Excel.Workbook
    Dim rs As DAO.Recordset
    Dim Fld As DAO.Field
    Dim fWasOpen As Boolean

    If Len(Dir(strTargetWB)) = 0 Then
        MsgBox "File '" & strTargetWB & "' not found!", vbExclamation
    Else
        On Error Resume Next
        Set XL = GetObject(, "Excel.Application")
        fWasOpen = Len(XL.Workbooks(Dir(strTargetWB)).Name) > 0
        Set WB = GetObject(strTargetWB)
        If WB Is Nothing Then
            Set XL = New Excel.Application
            XL.Visible = True
            Set WB = XL.Workbooks.Open(strTargetWB)
        End If
        If WB Is Nothing Then
            MsgBox "Unable to open " & strTargetWB & "!", vbExclamation
        Else
            Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenForwardOnly)
            If rs Is Nothing Then
                MsgBox "Unable to open the '" & strSQL & "' expression!", vbExclamation
            Else
                On Error GoTo ErrHandler
                With WB.Sheets(1)
                    If rs.RecordCount > 0 Then
                        '~~~to the nitty-gritty~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                        'Headers in first row
                        With .Cells(1, .Range(strTargetCell).Column).Resize(1, 8)
                            .Cells = Array("MANUF NO", "SL-NUMBER", "PARTNER", "PRODUCT TYPE", _
                                           "PO-NUMBER", "SHIPPED", "DELIVERY DATE", "ON LINE XL ROW NO")
                            .EntireColumn.AutoFit
                        End With
                        'Update the values of cells of each row starting form "strTargetCell"
                        With .Range(strTargetCell)
                            While Not rs.EOF
                                For Each Fld In rs.Fields
                                    .Offset(rs![xlRow] - 1, Fld.OrdinalPosition) = Fld
                                Next Fld
                                rs.MoveNext
                            Wend
                            UpdateExcel = rs.EOF    'All rows updated
                        End With
                        '~~~Updates done~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                    Else
                        MsgBox "There is nothing to export!", vbExclamation
                    End If
                End With
            End If
        End If
    End If
ExitHere:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    If fWasOpen Then
        WB.Save
    Else
        WB.Windows(1).Visible = True
        WB.Close True
    End If
    Set WB = Nothing
    Set XL = Nothing
    Exit Function
ErrHandler:
    Select Case Err
            '
        Case Else
            MsgBox "Unexpected error!" & vbCrLf & Err.Description, _
                   vbExclamation, "Update Excel Error(" & Err & ")"
            Err.Clear
            Resume ExitHere
    End Select
End Function

You can use it in your code like that:

    If UpdateExcel("tblSheet", CurrentProject.Path & "\TargetBook.xlsx", "c15") Then
        MsgBox "TargetBook.xlsx is updated!", vbInformation
    End If

Hope this helps!