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...
Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

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

NAS Cloud Backup Strategies

This article explains backup scenarios when using network storage. We review the so-called “3-2-1 strategy” and summarize the methods you can use to send NAS data to the cloud

Question has a verified solution.

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

Suggested Solutions

Recently Microsoft released a brand new function called CONCAT. It's supposed to replace its predecessor CONCATENATE. But how does it work? And what's new? In this article, we take a closer look at all of this - we even included an exercise file for…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…

777 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