Non-Contiguous Copy paste problem 2

[Walter349]

trying run this on a test workbook, but I am getting an Object error.

This is a test that will be applied to the proper workbook once it is finalised, there are more columns in the proper workbook than are currently in the test workbook to simplify things.

The test workbook has two worksheets, "DATA" and "ESTIMATE"
DATA is the source worksheet and ESTIMATE is the destination.

I am trying to copy non-contiguous cells from each row of the source worksheet "DATA" to the destination worksheet "ESTIMATE"

The rows that need to be copied are indicated in column7 "MARK" with an 'X' This is the factor for selecting which rows to copy.

DATA consists of seven columns in this test workbook.

Column1 = Title - Data required to copy
Column2 = NR1 - Data not required in this test
Column3 = Data1 - Required to Sum
Column4 = Data2 - Required to Sum
Column5 = NR2 - data not required in this test
Column6 = Data3 - Data required to copy
Column7 = Mark - indicates which rows to to be copied

Columns 3(Data1) & 4(Data2) need to be summed and the result placed in the destination worksheet "ESTIMATE".The individual cell data is not required to be copied, only the result.

So the row/cells of Columns 1 & 6 are copied and the results of the sum of row/cells in columns 3 & 4 are pasted to the destination worksheet.

The destination worksheet will have previous data that has been copied across so needs to start at the next available row of the destination worksheet.

Sub copyPasteTest()
For Each Mrk In Range("G2:G" & Cells(Rows.Count, 1).End(xlUp).Row)
 If Not IsEmpty(Mrk) Then
    With Worksheets("Estimate").Cells(Rows.Count, 1).End(xlUp).Row
        .Value = .Value + Worksheets("data").Cells(1, 1).Value
        .Value = .Value + Worksheets("data").Cells(1, 3).Value + .Value = .Value + Worksheets("data").Cells(1, 4).Value
        .Value = .Value + Worksheets("data").Cells(1, 6).Value
    End With
 End If
Next ce

End Sub

'If at first you don't succeed, then your hammer is below specifications'

 

[SkipVought]

hi,

You are doing NO copies and pastes. You are ASSIGNING values from one range to another.

    With Worksheets("Estimate").Cells(Rows.Count, 1).End(xlUp)[b].Offset(1)[/b]
        .Value = .Value + Worksheets("data").Cells(1, 1).Value
        .Value = .Value + Worksheets("data").Cells(1, 3).Value + .Value = .Value + Worksheets("data").Cells(1, 4).Value
        .Value = .Value + Worksheets("data").Cells(1, 6).Value
    End With
Next [b]Mrk[/b]

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Walter349]

Hi skip,

Thanks for your help(As always)

I have made the modifications that you suggested, but I am getting a 'runtime error 13 type mismatch'.

The souce data is as below, the data cells in columns Data1 & Data2 are numeric formatted.

Title	NR1	Data1	Data2	NR2	Data3	Mark
A               1        6               Z       x
B               2        5               A	
C               3                        D       x
D               4        3               F	
E               5        2               G       x
F               6        1               R       x

The error appears to be from line six. I have commented out the second part of the code to isolate where the error is starting, which appears to be the cell under Data1, but I suspect that the second part of the code will produce the same error as the source code is essentially the same in form and content type in Data2.

        .Value = .Value + Worksheets("data").Cells(2, 3).Value '+ .Value = .Value + Worksheets("data").Cells(2, 4).Value

The complete code now looks like this.

Sub LPDataMoveTst()
For Each Mrk In Range("G2:G" & Cells(Rows.Count, 1).End(xlUp).Row)
 If Not IsEmpty(Mrk) Then
    With Worksheets("Estimate").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .Value = .Value + Worksheets("data").Cells(2, 1).Value
        .Value = .Value + Worksheets("data").Cells(2, 3).Value '+ .Value = .Value + Worksheets("data").Cells(2, 4).Value
        .Value = .Value + Worksheets("data").Cells(2, 6).Value
    End With
 End If
Next Mrk

End Sub

Can you identify where I am going wrong on this?

Thanks

'If at first you don't succeed, then your hammer is below specifications'

 

[xlbo]

.Value = .Value + Worksheets("data").Cells(2, 3).Value '+ .Value = .Value + Worksheets("data").Cells(2, 4).Value

is syntactically incorrect. You can only assign something once per line:

.Value = .Value + Worksheets("data").Cells(2, 3).Value + Worksheets("data").Cells(2, 4).Value

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[SkipVought]

no excuse for letting that one slip thru!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Walter349]

I am still getting the type mismatch, but I cannot identify why, There is no reason that I can see that accounts for it.

It is definitely when it gets to the numeric cells for Data1

Any ideas?



'If at first you don't succeed, then your hammer is below specifications'

 

[SkipVought]

When your code errors, hit the debug and use the Watch Window to DISCOVER the value(s) in your formula...

faq707-4594

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Walter349]

Skip,

Tried the watch window using the .value for line 6 as that is the statement that errors. In the watch window it says 'expression not defined in context'

When stepping through it does not show any values at all or change in any way.

Tried it with the .value statement for line 5 that I know does pass the value and the same thing again as for line 6.

So I am pretty stuck here as I cannot identify why this does not work.

'If at first you don't succeed, then your hammer is below specifications'

 

[Walter349]

OK,

In an effort to isolate the problem, I have changed the cell content for column 3(Data1)in the source worksheet (DATA) to alphabetic and commented out the second half of line six.

The result is that the macro runs, without an error code, but results in all three data selections from the source worksheet (DATA, (Title, Data1, Data3) being concatenated into column A (Title) of the destination sheet(Estimate). Instead of into the three columns expected.

So it looks like this on the destination worksheet (Estimate)

Title   Data1   Data3
AzZ

When I was expecting this

Title   Data1   Data3
A        z       Z

Any thoughts on this?


'If at first you don't succeed, then your hammer is below specifications'

 

[SkipVought]

Maybe this???

        With Worksheets("Estimate").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            .Value = .Value + Worksheets("data").Cells(2, 1).Value
            .Offset(0, 1).Value = .Value + Worksheets("data").Cells(2, 3).Value + Worksheets("data").Cells(2, 4).Value
            .Offset(0, 2).Value = .Value + Worksheets("data").Cells(2, 6).Value
        End With

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Walter349]

Skip, xlbo,

Mant thanks for the guidance and assitance on this. Everyting is doing what I wanted. This is the final code as applied to the real workbook

'Moves and calculates totals for all Local Purchase Items marked for updating with a mark in the column

Sub LPDataMoveTst()
Dim Y As Long

Y = 2

For Each Mrk In Range("U2:U" & Cells(Rows.Count, 1).End(xlUp).Row)
 If Not IsEmpty(Mrk) Then
    With Worksheets("Etat local purchase").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .Value = Worksheets("Delivery").Cells(Y, 1).Value 'date
        .Offset(0, 1).Value = Worksheets("Delivery").Cells(Y, 2).Value ' Ticket No
        .Offset(0, 2).Value = Worksheets("Delivery").Cells(Y, 3).Value ' item No
        .Offset(0, 3).Value = Worksheets("Delivery").Cells(Y, 4).Value ' Designation
        .Offset(0, 4).Value = Worksheets("Delivery").Cells(Y, 5).Value ' codification
        .Offset(0, 5).Value = Worksheets("Delivery").Cells(Y, 6).Value ' Site Qty
        .Offset(0, 6).Value = Worksheets("Delivery").Cells(Y, 7).Value ' Logs qty
        .Offset(0, 7).Value = Worksheets("Delivery").Cells(Y, 8).Value ' Unit of measure
        .Offset(0, 9).Value = Worksheets("Delivery").Cells(Y, 12).Value ' Requestor name
        .Offset(0, 10).Value = Worksheets("Delivery").Cells(Y, 13).Value ' requestor site
        .Offset(0, 16).Value = Worksheets("Delivery").Cells(Y, 19).Value ' Status
        .Offset(0, 18).Value = Worksheets("Delivery").Cells(Y, 20).Value 'Comments
    End With
  
 End If
 Y = Y + 1
Next Mrk
End Sub

'If at first you don't succeed, then your hammer is below specifications'