Using VBA to consolidate a Excel worksheet

Posted on 2000-02-25
Last Modified: 2011-04-14
I have a worksheet with a few hundred data groups and I like to consolidate the
data to another worksheet. Each data group starts with a title row looks like:


Each group has 10-20 data lines. Each line represents a material layer and has 4
data in column A, B, C, and D, except the first line that has 5 data. The data
in column A is thickness of the layer and B, C, D are the material
specifications. The fifth data of first data line is the total thickness of the
layers in the group. There are 1-4 blank lines between the data groups. The data
looks like these:

Col A       Col B     Col C     Col D           Col F
45.02        3        P_1       33            228.26  <= first data line
27.32        3        P_1       33                    col F = Sum of Col A      
15.02        4        P_1       45                     of the data group
 6.47        4        P_1       45
 7.47        3        P_1       33
28.34        3        P_1       21
98.62        3        P_2       45

I like to using VBA to rewrite the data into another worksheet. The title row
will be copied and blank lines between data groups will be removed. If the
adjacent layers have same specifications (Column B,C,D), the thickness will be
added up and become a single layer. Therefore, the number of data rows will be
reduced, but the order of the layers and total thickness of layers will remain
the same.

72.34        3        P_1       33                             228.26
21.49        4        P_1       45
 7.47        3        P_1       33
28.34        3        P_1       21
98.62        3        P_2       45
35.61        3        P_1       33                             196.26

Can any body help?

Thanks in advance.

Best Regards.
Question by:tkc
  • 3
  • 2
LVL 17

Expert Comment

ID: 2560822
Hi tkc,

following macro should do the job for you.

In the beginning of the macro, the variables Source and Dest are assigned to "sheet1" and "sheet2", you'll have to enter the worksheet names of your choice in there.

Sub TransformSheet()
Dim Source As Worksheet, Dest As Worksheet
Dim i As Integer, NuLi As Integer, EndBlock As Integer
Dim j As Integer, k As Integer, Thick As Double
Set Source = Sheets("sheet1")
Set Dest = Sheets("sheet2")
NuLi = Source.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
j = 1
i = 1
While i <= NuLi
If Source.Cells(i, 1) <> "" Then
EndBlock = Source.Cells(i, 1).End(xlDown).Row
Dest.Cells(j, 1) = Source.Cells(i, 1)
j = j + 1
Start = j
    With Source
    For k = i + 1 To EndBlock
    If .Cells(k, 2) = .Cells(k + 1, 2) And .Cells(k, 3) = .Cells(k + 1, 3) And .Cells(k, 4) = .Cells(k + 1, 4) Then
    Thick = .Cells(k, 1) + Thick
    Thick = .Cells(k, 1) + Thick
    Dest.Cells(j, 1) = Thick
    Dest.Cells(j, 2) = .Cells(k, 2)
    Dest.Cells(j, 3) = .Cells(k, 3)
    Dest.Cells(j, 4) = .Cells(k, 4)
    Thick = 0
    j = j + 1
    End If
    Next k
    Dest.Cells(Start, 6).Formula = "=Sum($A$" & Start & ":$A$" & j - 1 & ")"
    End With
i = EndBlock + 1
i = i + 1
End If
End Sub

Have Fun


PS If you need more explanation, just shout

Author Comment

ID: 2561182

Hello, Calacuccia, Thank you very much for your help.  
The macro works fine, except that a Run-time error '1004' (Unable to get the specialCells property of the Range Class) was shown relate to the line:
I commented out the line, then set NuLi=500. The macro works. I use Excel 97 SR2, is it any problem for this version?  BTW, could you please show me how to copy the row of the title line (not only the column A)?

Thanks again. I really appreciate it.

LVL 44

Expert Comment

ID: 2561196
hmmm...good answer and got no trouble running it here in Excel2000...
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

LVL 17

Accepted Solution

calacuccia earned 200 total points
ID: 2562678

To copy the entire title line, change the line (just after the EndBlock line)
Dest.Cells(j, 1) = Source.Cells(i, 1)
Dest.Rows(j).Value = Source.Rows(i).Value

I don't know why the xlCellTypeLastCell gives a run-time error, just as Bruintje shows (thanks for support, Bruintje), I've had no problem in Excel 97 SR1.

It would surprise me that SR2 gets this property buggy. If you can live with setting NuLi to 500 than your problem is by-passed.

Found following article about run-time errors using the specialCells properties:
This one occurs when you have the sheet protected, workaround: unprotect your sheet.
Maybe that applies to you ?



Author Comment

ID: 2562790
Hi, Calacuccia,
         Thank you for the help. The macro works great now. I can live by manually setting NuLi. I really appreciate your fast responce and enjoy the program.
         Thanks again.
Best regard,
LVL 17

Expert Comment

ID: 2562800
Thanks TKC

Glad you liked the program


Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
This video shows and describes the main difference between both orientations in Microsoft Word. Viewers will understand when to use each orientation and how to get the most out of them.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question