VBA to copy last row of one sheet onto another sheet

[nirvehex]

Hi,

I have one main Sheet called "Data Table" with columns A through L populated across hundreds of rows (1 row for each week day). Then I have other sheets which pull various data points from this main "Data Table" sheet.

What I'm trying to do is create some VBA code that copies data from the last row of the "Data Table" sheet onto other sheets (example to follow) if and only if the other sheets do not have the same amount of rows populated as the "Data Table" sheet. So as I populate a new row on the Data table and run the macro, it will copy certain columns from the last row of the "Data Table" onto a different sheet.

For example:

On the Data Table I have columns A through L populated. One of the sheets I need the last row copied to is called "Price Predictor". However, I don't need the entire last row copied. Only the last row in column A on the "Data Table" sheet to the first empty row at the bottom of column A on the "Price Predictor" sheet. Also I need the last row in column B on the "Data Table" sheet to the first empty row at the bottom of column B on the "Price Predictor" sheet. Following the same logic I need column D to column C, column K to column E, column E to column F.

Then in column G on the "price predictor" sheet I need it to copy down the formula from the cell above it.

Then in column H on the "price predictor" sheet I need the formula: =IF(currentrowincolumnE=1,"P",IF(currentrowincolumnE=2,"B","F")).

I know this is a lot, but I was hoping someone could help me out here, especially with the first part in copying the rows from the first sheet to the second sheet. I was also hoping to keep the code relatively simple, so I can emulate it for other sheets.

Thank you so much all!

[snb]

Sub M_snb()
  with sheets("Data Table").cells(1).currentregion
    sn=.rows(.rows.count)
  end with

  sheets("price predictor").cells(rows.count,1).end(xlup).offset(1).resize(,5)=array(sn(j,1),sn(j,2),sn(j,4),sn(j,8),sn(j,5))
end sub

[jolivanes]

My interpretation is different.
Change Sheet references as required.

Sub nirvehex()
Dim r1, r2, lr1 As Long, lr2 As Long, ws1 As Worksheet, ws2 As Worksheet, j As Long
    r1 = Array(1, 2, 4, 5, 11)
    r2 = Array(1, 2, 3, 6, 5)
    Set ws1 = Sheets("Sheet2")    '<---- Change as required
    Set ws2 = Sheets("Sheet3")    '<---- Change as required
    lr1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    lr2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
        For j = LBound(r2) To UBound(r2)
            ws2.Cells(lr2 + 1, r2(j)).Value = ws1.Cells(lr1, r1(j))
        Next j
    ws2.Cells(lr2, 7).Copy ws2.Cells(lr2 + 1, 7)
    ws2.Cells(lr2 + 1, 8).Formula = "=IF(currentrowincolumnE=1,""P"",IF(currentrowincolumnE=2,""B"",""F""))"
End Sub

[nirvehex]

jolivanes,

Thank you for the code. It does pretty much what I want it to do. However, when ever I try to save my file after adding your code, Excel says there is a sharing violation and won't save my file. I can save if I alter anything on the worksheets and even if I add any other VBA code. I'm using Excel 2010, and I'm wondering if there is something in your code that is not compatible with that or alters permissions or something.

Thanks!

[nirvehex]

[QUOTE=snb;338985]

Sub M_snb()
  with sheets("Data Table").cells(1).currentregion
    sn=.rows(.rows.count)
  end with

  sheets("price predictor").cells(rows.count,1).end(xlup).offset(1).resize(,5)=array(sn(j,1),sn(j,2),sn(j,4),sn(j,8),sn(j,5))
end sub

[/QUOTE

snb, Thank you, but I keep getting an error when I run this code. It's on the line with the array. jolivanes code works, but for some reason I can't save after I add his code. Any other ides?

[jolivanes]

This is one of the many when you google the problem.
I don't know what the problem is as I have not encountered it.
Sorry about that.

http://www.proposedsolution.com/solu...ing-violation/

[nirvehex]

jolivanes,

LOL - trust me I've tried all sorts of fixes for this problem. So weird that it only happens when I add this code. I'm going to try to upgrade to 2013 and see if it still happens. You're code is perfect if my excel wouldn't crash!

[jolivanes]

I wish I knew what to say to help but I don't.
Good luck though.

[nirvehex]

jolivanes - Good news. I installed Excel 2013 and the error is gone. Now if I could ask you some questions to tweak your code a little bit that would be awesome!

1) It seems to miss copying column C from the Data table tab to column D on the Price Predictor tab.
2) when i wrote the part where it says "Then in column H on the "price predictor" sheet I need the formula: =IF(currentrowincolumnE=1,"P",IF(currentrowincolumnE=2,"B","F"))" I didn't mean it so literally. What I'm trying to do is write the formula in column H so that the newly found row that your code pastes in would be the "current row".
3) Any way to copy down the formatting from the row above the newly pasted row?

Thanks!

[jolivanes]

Nice to hear that your one problem has disappeared.
No1 is simple. It was not asked for as far as I can see.
No2 needs some more explaining in order for me to understand it
No3 should work as in below changes.

Sub nirvehex() 
Dim r1, r2, lr1 As Long, lr2 As Long, lc2 As Long, ws1 As Worksheet, ws2 As Worksheet, j As Long
    r1 = Array(1, 2, 3, 4, 5, 11)
    r2 = Array(1, 2, 4, 3, 6, 5)
    Set ws1 = Sheets("Sheet2")    '<---- Change as required 
    Set ws2 = Sheets("Sheet3")    '<---- Change as required 
    lr1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    lr2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    lc2 = ws2.UsedRange.Columns.Count
        For j = LBound(r2) To UBound(r2)
            ws2.Cells(lr2 + 1, r2(j)).Value = ws1.Cells(lr1, r1(j))
        Next j
    With ws2
        .Cells(lr2, 7).Copy .Cells(lr2 + 1, 7)
        .Range(.Cells(lr2, 1), .Cells(lr2, lc2)).Copy
        .Range(.Cells(lr2 + 1, 1), .Cells(lr2 + 1, lc2)) _
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    End With
End Sub

[nirvehex]

Thank for the updates to the code! Number 1 and 3 work perfectly now. As for number 2 I'll try to explain better (it was late last night and I think I was rambling )

So let's just say your code copied the selected columns from row 469 on the Sheet2 to row 469 (previously blank) on Sheet3 into the selected columns. In column H on Sheet3 I'm trying to say this: =if(E469=1,"P",if(E469=2,"B","F"))". But again this cell is going to change as more rows are added. Next time it will be E470 and then E471 and so on. I hope this explanation is more easy to understand! Thanks again for your continued support!

[nirvehex]

Hey jolivanes,

Nevermind. I'm just going to use the copy function like you did with

.Cells(lr2, 7).Copy .Cells(lr2 +1, 7)

Probably be easier and more efficient then having the code run a formula each time.

[nirvehex]

Actually jolivanes,

Something just dawned on me. I can use the copy function for each column instead of using the arrays to copy! WOW I can't believe I did not think of this before. I've adjusted your code to just use the copy function.

Sub CopyLastRowToPricePredictor()
    Dim lr1 As Long, lr2 As Long, lc2 As Long, ws2 As Worksheet
    Set ws2 = Sheets("Price Predictor") '<---- Change as required
    lr2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    lc2 = ws2.UsedRange.Columns.Count
    With ws2
        .Cells(lr2, 1).Copy .Cells(lr2 + 1, 1)
        .Cells(lr2, 2).Copy .Cells(lr2 + 1, 2)
        .Cells(lr2, 3).Copy .Cells(lr2 + 1, 3)
        .Cells(lr2, 4).Copy .Cells(lr2 + 1, 4)
        .Cells(lr2, 5).Copy .Cells(lr2 + 1, 5)
        .Cells(lr2, 6).Copy .Cells(lr2 + 1, 6)
        .Cells(lr2, 7).Copy .Cells(lr2 + 1, 7)
        .Cells(lr2, 8).Copy .Cells(lr2 + 1, 8)
        .Range(.Cells(lr2, 1), .Cells(lr2, lc2)).Copy
        .Range(.Cells(lr2 + 1, 1), .Cells(lr2 + 1, lc2)) _
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    End With
End Sub

Anyway to condense those lines into one like say 1-8 instead of each on a separate line? Thanks! Sorry I didn't think of this earlier.

[jolivanes]

The result of this

.Cells(lr2, 1).Copy .Cells(lr2 + 1, 1) 
.Cells(lr2, 2).Copy .Cells(lr2 + 1, 2) 
.Cells(lr2, 3).Copy .Cells(lr2 + 1, 3) 
.Cells(lr2, 4).Copy .Cells(lr2 + 1, 4) 
.Cells(lr2, 5).Copy .Cells(lr2 + 1, 5) 
.Cells(lr2, 6).Copy .Cells(lr2 + 1, 6) 
.Cells(lr2, 7).Copy .Cells(lr2 + 1, 7) 
.Cells(lr2, 8).Copy .Cells(lr2 + 1, 8)

is the same as this

.Range(.Cells(lr2, 1), .Cells(lr2, 8)).Copy .Range(.Cells(lr2 + 1, 1), .Cells(lr2 + 1, 8))

or this

.Range("A" & lr2).Resize(, 8).Copy .Range("A" & lr2 + 1)

but all it does is copy and paste the last used row from A to E to the next row in the same sheet.

[jolivanes]

Forgot about your formula.
Insert this below the 1st line in the "With ws2" part of the code

.Cells(lr2 + 1, 8).Formula = "=IF(RC[-3]=1, ""P"", IF(RC[-3]=2, ""B"",""F""))"
.Cells(lr2 + 1, 8).Value = .Cells(lr2 + 1, 8).Value

[snb]

Why not ?

Sub M_snb() 
    With sheets("Data Table").cells(1).currentregion 
        sn=.rows(.rows.count).formula 
    End With 
     
    sheets("price predictor").cells(rows.count,1).end(xlup).offset(1).resize(,5)=array(sn(1,1),sn(1,2),sn(1,4),sn(1,8),sn(1,5)) 
End Sub

[nirvehex]

Well I guess that works as well. Thanks for the answers/help everyone!