Consilidating and Transferring data from multiple sheets

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