Consilidating and Transferring data from multiple sheets - vba

Question

I am stuck on a transfer of data in to a summary sheet. I have 2 sheets and want to summarize it in to a third sheet.
Sheet A
A B C D
1 Apple Orange Peach
2 Period Apple_Price Orange_price peach_price
3 1 5 5 3
4 2 6 4 9
5 3 7 7
Sheet B
A B C D
1 Apple Orange Peach
2 Period Apple_weight Orange_Weight peach_Weight
3 1 2.1 2.5 3.1
4 2 2.1 1.1 2.1
5 3 3.1 2.5
Summary sheet or sheet c (expected)
A B C D
1 Period Price Weight
2 Apple 1 5 2.1
3 2 6 2.1
4 3 7 3.1
5 Orange 1 5 2.5
6 2 4 1.1
7 Peach 1 3 3.1
8 2 9 2.1
9 3 7 2.5
The code I have started writing is somewhat like
For Each Name In Range("B1:D1")
' To copy each name in to first column of summary
Name.Cells.value.copy Worksheets("Summary").Offset(2,0)
' Now to copy a column from each sheet in front of corresponding name
Worksheets("SheetA").Range(Name & lastrow).Copy
Worksheets("summary").Range("a65536").End(xlUP).Offset(2,1)
'Now copy Periods and prices
Worksheets("SheetA").Range(Name & lastrow).Copy
Worksheets("summary").Range("a65536").End(xlUP).Offset(2,2)
'Now copy weights
Worksheets("SheetB").Range(Name & lastrow).Copy
Worksheets("summary").Range("a65536").End(xlUP).Offset(2,3)
Next
Unfortunately I am not able to get this work. There's some problem with offset I guess.

Answer 1

First let us look at your existing code.
For Each Name In Range("B1:D1")
This assumes three fruit. When you add a fourth, you will have to update this code and again when you add a fifth. Does the person who decides which fruit are of interest, maintain the macro? If not, every time they add a fruit, they will have to request an update to the macro.
Deciding what possible future changes to allow for is a balance:
It is almost no effort to allow for extra fruit or extra periods and in most situations this is a very likely change so I normally allow for it.
Currently you have price and weight as interesting properties. Allowing for new properties could be tricky; I would not normally bother.
Are the fruit in the same sequence? Are the periods in the same sequence? Allowing for these changes is more bother than allowing for extra fruit or periods so should I allow for them? In an earlier life, I was responsible for a lot of similar tasks. Worksheets formats were often changed for no reason I could understand. If I simply assumed the worksheets were the format I expected, I could create realistic but wrong summaries and the error might not be recognised for some time. At the very least, I always performed checks for worksheets being in the format I expected.
I am not asking you to agree with my assessment of what changes to prepare for since I know nothing about your application. I am asking you to think about the issue. A change you have not checked for could lead to a corrupt summary or a crashed macro. How important is this? A change you have checked for but do not handle means the macro cannot be run until you update it. How important is this?
Worksheets("summary").Range("a65536").End(xlUP).Offset(2,1)
Prior to Excel 2007, a worksheet had 65536 rows so cell A65536 was the bottom of column A. Anyone who has coded since 2007 would have suggested Cells(Rows.Count, 1) instead of Range("a65536")because it specifies the bottom of column A for the current version of Excel whatever it is.
I do not like Offset because you have to perform mental arithmetic to determine which cell is being addressed. If the number of periods is not always exactly three, you will have to perform arithmetic on the offset row. That is: Offset(2, 1) will have to be replaced by something like Offset(2+Period-1, 1). In addition you have started at the bottom of column A, moved up to the first cell in the column with a value before performing the offset.
If your code is to be performed millions of times per day, shaving a millisecond off the run time might be appropriate but is it appropriate here? How long did it take you to write this code (which does not work anyway) and how long will it take a future maintainer of your code to understand what you are doing? My advice is to make code simple and easy to write unless there is some overwhelming reason for it to be complex and difficult to write.
My code included little tricks for saving time. These are all easy to implement and can become automatic. If it takes you 10 or 20 seconds to type a statement that saves the user a noticeable fraction of a second, the company can get a return on its investment (Your coding time < User's waiting time) within a few months. Also, some of these tricks make future maintenance easier. Always make life easier for the person who has to update this macro in 6 or 12 months because that person might be you.
Please do not use name like “SheetA” or “SheetB”. Names like “Price” and “Weight” immediately tell you the worksheet’s purpose. Meaningful names make like so much easier.
I think that is enough criticism.
Work through this code carefully. There are lots of comments explaining what I am attempting but few comments explaining what each statement does so you will have to look those up if you don’t know and cannot guess. Use F8 to step through the macro statement by statement. Do you understand what each statement does and why I wanted that done? Come back with questions if necessary but the more you can work out for yourself the faster you will develop your own skills.
Option Explicit
' Constants make maintenance so much easier:
' * You code is full of meaningful names rather than numbers whos purpose
' must be looked up.
' * If columns are rearranged or an extra heading line added to one of the
' worksheets, one change here and the problem is fixed.
Const ColPWPeriod As Long = 1
Const ColPWDataFirst As Long = 2
Const ColSummaryFruit As Long = 1
Const ColSummaryPeriod As Long = 2
Const ColSummaryPrice As Long = 3
Const ColSummaryWeight As Long = 4
Const ColSummaryLast As Long = 4
Const RowPWFruit As Long = 1
Const RowPWDataFirst As Long = 3
Sub CombineABIntoS()
Dim ColPriceLast As Long
Dim ColPWCrnt As Long
Dim ColWeightLast As Long
Dim FruitCrnt As String
Dim RowPriceLast As Long
Dim RowPWCrnt As Long
Dim RowSummaryCrnt As Long
Dim RowWeightLast As Long
Dim WshtPrice As Worksheet
Dim WshtWeight As Worksheet
Dim WshtSummary As Worksheet
' Updating the screen for each change can be very time consuming.
Application.ScreenUpdating = False
' * It takes the interpreter a noticable fraction of a second to process
' Worksheets("Xxxxx") because it has to look "Xxxxx" up in its collection
' of worksheet names. These cause these look ups to be performed once and
' the result stored. With all the switching between worksheets this can
' reduce duration noticably.
' * If the names of the worksheets change, only these statements will need
' amendment to fully update the macro.
' * These are not your names. If you do not accept my advice, change to
' your worksheet names
Set WshtPrice = Worksheets("Price")
Set WshtWeight = Worksheets("Weight")
Set WshtSummary = Worksheets("Summary")
' For price worksheet, find last row with a period and last column with a fruit
With WshtPrice
ColPriceLast = .Cells(1, Columns.Count).End(xlToLeft).Column
RowPriceLast = .Cells(Rows.Count, ColPWPeriod).End(xlUp).Row
End With
' For weight worksheet, find last row with a period and last column with a fruit
With WshtWeight
ColWeightLast = .Cells(1, Columns.Count).End(xlToLeft).Column
RowWeightLast = .Cells(Rows.Count, ColPWPeriod).End(xlUp).Row
End With
' Check worksheets match.
' Check same number of fruits
If ColPriceLast <> ColWeightLast Then
Call MsgBox("Worksheet " & WshtPrice.Name & " has " & _
ColPriceLast - ColPWDataFirst + 1 & _
" fruit while worksheet " & WshtWeight.Name & " has " & _
ColWeightLast - ColPWDataFirst + 1 & _
". Sorry I cannot handle this situation", _
vbOKOnly, "Combine Price and Weight worksheets")
Exit Sub
End If
' Check same number of periods
If RowPriceLast <> RowWeightLast Then
Call MsgBox("Worksheet " & WshtPrice.Name & " has " & _
RowPriceLast - RowPWDataFirst + 1 & _
" periods while worksheet " & WshtWeight.Name & " has " & _
RowWeightLast - RowPWDataFirst + 1 & _
". Sorry I cannot handle this situation", vbOKOnly, _
"Combine Price and Weight worksheets")
Exit Sub
End If
' Check same fruits in same sequence.
' Note: have already checked ColPriceLast = ColWeightLast
For ColPWCrnt = ColPWDataFirst To ColPriceLast
If WshtPrice.Cells(RowPWFruit, ColPWCrnt).Value <> _
WshtWeight.Cells(RowPWFruit, ColPWCrnt).Value Then
Call MsgBox("Cell " & ColNumToCode(ColPWCrnt) & RowPWFruit & _
" of worksheet " & WshtPrice.Name & " = """ & _
WshtPrice.Cells(RowPWFruit, ColPWCrnt).Value & _
""" while the same cell in worksheet " & _
WshtWeight.Name & " = """ & _
WshtWeight.Cells(RowPWFruit, ColPWCrnt).Value & _
""". Sorry I cannot handle this situation", vbOKOnly, _
"Combine Price and Weight worksheets")
Exit Sub
End If
Next
' Check same periods in same sequence.
' Note: have already checked RowPriceLast = RowWeightLast
For RowPWCrnt = RowPWDataFirst To RowPriceLast
If WshtPrice.Cells(RowPWCrnt, ColPWPeriod).Value <> _
WshtWeight.Cells(RowPWCrnt, ColPWPeriod).Value Then
Call MsgBox("Cell " & ColNumToCode(ColPWPeriod) & RowPWCrnt & _
" of worksheet " & WshtPrice.Name & " = """ & _
WshtPrice.Cells(RowPWCrnt, ColPWPeriod).Value & _
""" while the same cell in worksheet " & _
WshtWeight.Name & " = """ & _
WshtWeight.Cells(RowPWCrnt, ColPWPeriod).Value & _
""". Sorry I cannot handle this situation", vbOKOnly, _
"Combine Price and Weight worksheets")
Exit Sub
End If
Next
' Formats of two worksheets match
' For summary worksheet, clear existing contents, create header row
' and initialise row counter
With WshtSummary
.Cells.EntireRow.Delete ' Clear any existing contents
.Cells(1, ColSummaryFruit).Value = "Fruit"
.Cells(1, ColSummaryPeriod).Value = "Period"
.Cells(1, ColSummaryPrice).Value = "Price"
.Cells(1, ColSummaryWeight).Value = "Weight"
.Range(.Cells(1, 1), .Cells(1, ColSummaryLast)).Font.Bold = True
RowSummaryCrnt = 2
End With
For ColPWCrnt = ColPWDataFirst To ColPriceLast
' Can copy across fruit from either worksheet since checked to match
WshtSummary.Cells(RowSummaryCrnt, ColSummaryFruit).Value = _
WshtPrice.Cells(RowPWFruit, ColPWCrnt).Value
For RowPWCrnt = RowPWDataFirst To RowPriceLast
If WshtPrice.Cells(RowPWCrnt, ColPWCrnt).Value <> "" Or _
WshtWeight.Cells(RowPWCrnt, ColPWCrnt).Value <> "" Then
' There is either a price or a weight or both for this period and fruit
' Can copy across period from either worksheet since checked to match
WshtSummary.Cells(RowSummaryCrnt, ColSummaryPeriod).Value = _
WshtPrice.Cells(RowPWCrnt, ColPWPeriod).Value
' Copy across price and weight
WshtSummary.Cells(RowSummaryCrnt, ColSummaryPrice).Value = _
WshtPrice.Cells(RowPWCrnt, ColPWCrnt).Value
WshtSummary.Cells(RowSummaryCrnt, ColSummaryWeight).Value = _
WshtWeight.Cells(RowPWCrnt, ColPWCrnt).Value
' Step summart row ready fro next period or fruit
RowSummaryCrnt = RowSummaryCrnt + 1
End If
Next RowPWCrnt
Next ColPWCrnt
End Sub
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = Code
End Function