Solved: Copy from sheet1 & paste to sheet2 in corresponding column

[ScoobyDoo]

It's been over ten years since I last worked with VBA so I am rusty to say the least.

I have a spreadsheet with a simple table in Sheet1 with columns Date, Name, Amount, Type. The user simply adds items with Amount & categorises items using the Type column. In sheet2 I have a table with columns Date, Name, & columns for each of the Types...Food, Beverage, Other, Gas, Supermarket. Sheet2 will be populated using VBA & the data input in Sheet1. What I need is code which will:

In Sheet1 taking one row at a time grab the Name, Amount & Type
Go to Sheet2 place the Name in the Name column

Check what Type the item is....it could be Food, Beverage, Gas, Other, Deposit
Grab the corresponding Amount for that item
Goto Sheet2 & find the column with the corresponding Type & place the Amount into the row for that item
If the Type is Deposit the amount should be placed in the Deposit column
and then repeat for the next item

So when the code is executed the Item is placed in the Item column & then going across the row I could see the cost & what type it is in.

The aim is to have Sheet2 with the costs placed in the correct categories so it looks kind of scattered. I should point out the area where the amount is to be placed is conditionaly formatted & I would like to maintain this as much as possible.

I really don't know where to start with this one :banghead: I have attached a quick mockup to help. I hope I have explained this clearly however if anyone requires further information I will be happy to oblige. Any help will be greatly appreciated.

[Teeroy]

ScoobyDoo where are you? :rotlaugh:

OK bad joke... guilty as charged.

I can't look at this in detail at the moment but I will suggest since you're matching columns on sheet 2 that you enforce data validation in Col D of sheet 1.

[ScoobyDoo]

I will suggest since you're matching columns on sheet 2 that you enforce data validation in Col D of sheet 1.

That's a good point I didn't think of that.

I've been digging around on Google but cant find a scenario same as this. I have plenty where data is copied from one place to the other but nothing where it needs to go into different column & rows....I'll keep going this is reigniting by excitement for programming.

[Teeroy]

Hey ScoobyDoo,

The following should work for you. It uses pastespecial values to keep your conditional formatting.

Sub copy_and_code()
Dim rng
Dim aCodes
Dim i As Integer

With Sheets("sheet2")
.Range("a4", "g" & .UsedRange.Rows.Count - 2).ClearContents
End With
aCodes = Application.Transpose(Application.Transpose(Sheets("sheet2").Range("c2:g2").Value))

Sheets("sheet2").Activate
For Each rng In Sheets("Sheet1").Range("a2", Sheets("Sheet1").Range("a" & Cells.Rows.Count).End(xlUp))
Range(rng, rng.Offset(0, 1)).Copy
Sheets("sheet2").Range("A" & rng.Row + 2).PasteSpecial Paste:=xlPasteValues
For i = 1 To UBound(aCodes)
If UCase(rng.Offset(0, 3).Value) = aCodes(i) Then
rng.Offset(0, 2).Copy
Sheets("sheet2").Cells(rng.Row + 2, i + 2).PasteSpecial Paste:=xlPasteValues
End If
Next i
Next
Application.CutCopyMode = False
End Sub

[snb]

If the cursor is in one of the rows that should be 'copied' to sheet2 you can use


Sub snb()
If ActiveSheet.Name = "Sheet1" And ActiveCell.Row > 1 And ActiveCell.Value <> "" Then
With Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Resize(, 2) = ActiveCell.Offset(, 1 - ActiveCell.Column).Resize(, 2).Value
Sheets(2).Rows(2).Find(ActiveCell.Offset(, 4 - ActiveCell.Column).Value, , xlValues, xlWhole).Offset(.Row - 2) = ActiveCell.Offset(, 3 - ActiveCell.Column).Value
End With
End If
End Sub

[Teeroy]

BTW since the code I posted earlier refreshes Sheet2 each time it is run I'd call it from the Sheet2 Worksheet_Activate event so that any changes you've made to the master data on Sheet1 are reflected whenever you view Sheet2.

[ScoobyDoo]

WOW! Thanks for your help Teeroy your code worked like a charm.

I've slightly modified the aCodes range to include column i....DEPOSIT.

aCodes = Application.Transpose(Application.Transpose(Sheets("sheet2").Range("c2:i2").Value))

I also wanted to ask how I could make the items PROPER() case when they are copied from Sheet1 to Sheet2. For example spring water should be copied as Spring Water. I found STRCONV() function but not sure how to apply it to this:dunno Any ideas?

It looks like this line copies the date & item but not sure how to make it copy it as proper case

Range(rng, rng.Offset(0, 1)).Copy

[Teeroy]

I don't think you can do this in one operation but you can use the PROPER worksheet function immediately after the paste to replace the string with its Proper Case equivalent.

Sub copy_and_code()
Dim rng
Dim aCodes
Dim i As Integer

With Sheets("sheet2")
.Range("a4", "g" & .UsedRange.Rows.Count - 2).ClearContents
End With
aCodes = Application.Transpose(Application.Transpose(Sheets("sheet2").Range("c2:i2").Value))

Sheets("sheet2").Activate
For Each rng In Sheets("Sheet1").Range("a2", Sheets("Sheet1").Range("a" & Cells.Rows.Count).End(xlUp))
Range(rng, rng.Offset(0, 1)).Copy
Sheets("sheet2").Range("A" & rng.Row + 2).PasteSpecial Paste:=xlPasteValues
Sheets("sheet2").Range("B" & rng.Row + 2) = WorksheetFunction.Proper(Sheets("sheet2").Range("B" & rng.Row + 2)) ' This line added
For i = 1 To UBound(aCodes)
If UCase(rng.Offset(0, 3).Value) = aCodes(i) Then
rng.Offset(0, 2).Copy
Sheets("sheet2").Cells(rng.Row + 2, i + 2).PasteSpecial Paste:=xlPasteValues
End If
Next i
Next
Application.CutCopyMode = False
End Sub

[snb]

in one go:
Sub snb()
If ActiveSheet.Name = "Sheet1" And ActiveCell.Row > 1 And ActiveCell.Value <> "" Then
With Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Resize(, 2) = Split(Trim(StrConv(" " & Join(Application.Index(ActiveCell.Offset(, 1 - ActiveCell.Column).Resize(, 2).Value, 1, 0), "| "), vbProperCase)), "| ")
Sheets(2).Rows(2).Find(ActiveCell.Offset(, 4 - ActiveCell.Column).Value, , xlValues, xlWhole).Offset(.Row - 2) = ActiveCell.Offset(, 3 - ActiveCell.Column).Value
End With
End If
End Sub

[ScoobyDoo]

Awesome! Thanks for your help. It really helped to overcome the challenges with this piece code. Thanks guys!