copying data to another workbook trouble with cell.offsets and lastrow+1

[B-Man]

Hi All,

I'm having an issue copying from one workbook to another. I know why but don't know how to fix it.
Its hard to explain but here goes... formula below

i loop through my sheet looking for entries that haven't been entered. when it finds one I want it to copy part of the data in a different order into another sheet
I have my row I want to copy certain cells and paste them into the destination workbook at the end of the data.
I'm using cell.offset to get the correct cells from the table but I cant seem to use that in the formula to copy it to the destination book and in the right layout...
im trying to "select" without selecting the last row+1 in Column A on the destination sheet then using offsets to find the other cells it needs to copy values to.

Sub Copy_loop()
'Application.ScreenUpdating = False

    Dim wbSource As Workbook
    Dim wbDest As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
     
     
    Set wbSource = ActiveWorkbook
    Set wsSource = wbSource.Worksheets("Sales")

    On Error Resume Next                                                 ' trys to open file from one link. if on another user it will fail so opens on next user
    workbooks.Open Environ("USERPROFILE") & ("\OneDrive\Shared - User1\-- Register --\Summary.xlsm")
    workbooks.Open Environ("USERPROFILE") & ("\OneDrive\Shared - User2\-- Register --\Summary.xlsm")
    On Error GoTo 0
    

    If Not wsSource Is Nothing Then
        Set wbDest = workbooks("Summary.xlsm")
        Set wsDest = wbDest.Worksheets("Input 2016+")

End If

'dont need to dim last row if i can just assign cell in formula?
'Dim Lastrow As Long
'     Lastrow = wsDest.Range("A" & Rows.Count).End(xlUp).Offset(1)      ' Last Row +1


    For Each Cell In wsSource.Range("Table13[Paid]")
        If Cell.Value > 0 And Cell.Offset(0, 1).Value = "" Then
              Cell.Offset(0, 1).Value = "*"                             ' star cell to show it has been/will be entered



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''need help from here..... this is the copy part that doesnt work''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    With wsDest.Range("A" & Rows.Count).End(xlUp).Offset(1)             ' Find last row + 1 to paste data
    
'              (A) - Cell it need to go to in destination worksheet -  (worksheet source cell is offset from  ("Table13[Paid]"))
''.Range("A" & Rows.Count).End(xlUp).Offset(1) = wsSource.Cell.Offset(0, -7).Value
.Cell = wsSource.Cell.Offset(0, -7).Value

'              (D)
''Cell.Offset(0, 3).Value = wsSource.Cell.Offset(0, -1).Value

'              (M)
'Cell.Offset(0, 12).Value = wsSource.Cell.Offset(0, 2).Value &" - "  Cell.Offset(0, -6).Value ''''finalize combining cells

    End With

        End If
    Next Cell
    
'  workbooks("Summary.xlsm").Close savechanges:=True
  wbDest.Close savechanges:=True

        Application.ScreenUpdating = True

        wbSource.Activate

       MsgBox "Imported to Summary"

 

[GWteB]

Although you didn't declare it explicitly, you use a Range variable called Cell. Within the loop, this variable Cell is assigned a different range each time, but by definition a range present on the worksheet with the object ref wsSource. Within the same loop, your code then tries to address variable Cell as if its parent were the worksheet with the object ref wsDest. This is conflicting so will throw an error.
Because the desired result of the copying process has not become clear to me, I do not have any alternative code at the moment. You might consider providing examples of the source data and the target data using XL2BB.

 

[B-Man]

this is the source workbook table that im looking to copy data across from.

the macro runs through the rows in the table and if there's an entry that's been paid and hasn't
been copied to the summary work book then it copies it to the summary workbook
if the bills list column doesn't contain an * then it hasn't been copied to the summary work book. so that's the row/s that need to be done.

in table below the red cell is showing there is no * so it will be the row that needs to be copied. the yellow cells are what needs to be copied to the other worksheet

Sales - Copy.xlsm
	A	B	C	D	E	F	G	H	I	J
4	Date	Name	Half	Full	Half	Full	Sold $	Paid	Bills list	Comments
5	22-May	Kate	2		3		$ 100	Paid	*
6	23-May	Kathryn	4			1	$ 260	Paid	*
7	24-May	Carolyn		4			$ 440	Paid	*
8	24-May	Tania	1		1		$ 70	Paid	*
9	26-May	Roger	4			4	$ 260	Paid		to be picked up
Sales

destination sheet. in another workbook
yellow line is where I want to add it... needs to find the last row and copy data below it.
the row above is showing the headings from the source sheet where the values need to go (not normally there )
the red cells are pointing out I want to add a static value every time it writes a line. so I want that cell to always say "sales" when it writes that line and the initals to always be "tom"

Summary.xlsm
	A	B	C	D	E	F		H	I	J	K	L	M
4	Date	Type	Item	Cost	sale Initials								Comments
5	21-Nov-15	Sales		$ 659.00	aa
6	24-Jan-16	Sales		$ 390.27	ts
7	30-Jan-16	Sales		$ 39.00	tom
8	04-Feb-16	Sales		$ 735.67	ben
9	05-Feb-16	Sales		$ 48.00	bb
10	06-Feb-16	Sales		$ 21.30	cc
11	07-Feb-16	Sales		$ 88.54	dd
12	Date	Input value here "Sales"		Sold $	need to input value here " Tom"								comments go here
13	26-May	sales		$ 260.00	tom								to be picked up
14
Input 2016+

hope this is enough information

cheers.

 

[GWteB]

Okay, this is likely to do what you want. The code is supposed to be pasted into the Sales workbook. Note that I left out any declaration of whichever workbook variable. On occasions when a workbook involved needs to be referred to, the Parent property of that particular worksheet is used.

Public Sub Copy_loop()

    Dim wsSource    As Worksheet
    Dim wsDest      As Worksheet
    Dim c           As Range
    Dim bImported   As Boolean
    
    'Application.ScreenUpdating = False

    On Error Resume Next
    Set wsSource = ThisWorkbook.Worksheets("Sales")

    ' tries to open file from one link. if on another user it will fail so opens on next user
    Set wsDest = Application.Workbooks.Open(Environ("USERPROFILE") & "\OneDrive\Shared - User1\-- Register --\Summary.xlsm").Worksheets("Input 2016+")
    Set wsDest = Application.Workbooks.Open(Environ("USERPROFILE") & "\OneDrive\Shared - User2\-- Register --\Summary.xlsm").Worksheets("Input 2016+")
    On Error GoTo 0

    If Not wsSource Is Nothing Then
        If Not wsDest Is Nothing Then

            For Each c In wsSource.Range("Table13[Paid]")
                If c.Value > 0 And c.Offset(0, 1).Value = "" Then
                    c.Offset(0, 1).Value = "*" ' star cell to show it has been/will be entered
                    With wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).Offset(1, 0) ' Find last row + 1 to paste data
                        '              (A)
                        .Value = c.Offset(0, -7).Value
                        '              (B)
                        .Offset(0, 1).Value = "Sales"
                        '              (D)
                        .Offset(0, 3).Value = c.Offset(0, -1).Value
                        '              (E)
                        .Offset(0, 4).Value = "Tom"
                        '              (M)
                        .Offset(0, 12).Value = c.Offset(0, 2).Value & " - " & c.Offset(0, -6).Value ''''finalize combining cells
                        bImported = True
                    End With
                End If
            Next c
    
            With wsDest.Parent
                .Save
                .Close False
            End With

'            Application.ScreenUpdating = True

            If bImported Then
                MsgBox "Imported to Summary", vbInformation
            Else
                MsgBox "There's nothing to import.", vbInformation
            End If

        Else
            MsgBox "Destination workbook/worksheet could not be found", vbExclamation
        End If
    Else
        MsgBox "There's no sheet with the name ""Sales"" within this workbook.", vbExclamation
    End If

End Sub

 

[B-Man]

thanks worked an absolute dream

 

[GWteB]

You are welcome and thanks for letting me know.

 

[B-Man]

Hi,
I have noticed one issue.
when copying data across the dollar figure changes the formatting in my summary sheet to custom rather than accounting creating negative values to be encased in brackets (100.00) vs how it was currently set as -100.00
I set my formatting to accounting in the sales sheet, the same as the summary sheet but every time it copy's a row into the summary sheet the whole column formatting for the summary sheet changes to (100.00) not just the cell that's input.?

 

[GWteB]

You're describing weird behavior that I couldn't explain at first, but now I can. In this case Excel appears to treat a workbook in a kind of different way when a file is saved by VBA code instead of saving manually. It shouldn't be so, yet it is. Please read on. Because of the program flow as I wrote it, the Summary workbook is saved even if there's nothing to copy. Because of this behaviour (that has crept in the code because of a sort of laziness) I discovered this phenomenon, which in fact is causing your current issue.

My findings:
If a worksheet range is formatted with the predefined Accounting number format, its default format type is like:

 _ $* #,##0.00_ ;_ $*  -#,##0.00 ;_ $* ""-""??_ ;_ @_

Thus a minus sign is used for negative numbers. It's what you see on your workheet and can be confirmed by opening the Format Cells dialog > Number tab > and within the Category list box switching from Accounting to Custom.

A secondary format type of Accounting is where parentheses are used for negative values. That secondary format type is like:

_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)

It's the same format type returned by the macro recorder when a worksheet range's format is set to Accounting while recording.

My findings:
If the Accounting type 1 (with minus sign for negative numbers) is used on a worksheet range and the workbook is saved manually, this type remains as is and after opening the workbook the ribbon's format drop down is displaying "Accounting" for that particular range.
If saving is done by VBA-code, this type's place is taken by Accounting type 2. After opening the workbook negative numbers are between parentheses and the format drop down is displaying "Custom".
The conclusion therefore seems justified if one were to claim that VBA uses another format type as default for the Accounting format on saving a workbook than Excel does.

With the above knowledge, I modified the code by explicitly formatting column D:D with Excel's default format type for Accounting (so as a custom type). This also means that the ribbon's format drop down will display "Custom". The cell formatting, on the other hand, is as desired: negative numbers are displayed with a minus sign as opposed to parentheses.
Finally, please note that my findings relate to a system using Excel 2013, Windows 10 with negative number format -1.1 (within Win10 > Control Panel > Clock and Region > Region dialog > Formats tab > Additional settings ... button > Customize Format dialog > Numbers tab).

With your existing code, replace this snippet

                        '              (D)
                        .Offset(0, 3).Value = c.Offset(0, -1).Value

by the one below :

                        '              (D)
                        .Offset(0, 3).Value = c.Offset(0, -1).Value
                        .Offset(0, 3).EntireColumn.NumberFormat = "_ $* #,##0.00_ ;_ $*  -#,##0.00 ;_ $* ""-""??_ ;_ @_ "

Hopefully this resolves your issue.

 

[B-Man]

yes that fixed it.
Thanks

 

[GWteB]

Glad it's sorted. Thanks for letting me know.