Solved

Using VBA to consolidate a Excel worksheet

Posted on 2000-02-25
6
1,369 Views
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:

*TITLE (DATA GROUP NUMBER ONE)

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.

*TITLE (DATA GROUP NUMBER ONE)
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
*TITLE (DATA GROUP NUMBER TWO)
35.61        3        P_1       33                             196.26
...

Can any body help?

Thanks in advance.

Best Regards.
TKC
0
Comment
Question by:tkc
  • 3
  • 2
6 Comments
 
LVL 17

Expert Comment

by:calacuccia
Comment Utility
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
    Else
    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
Else
i = i + 1
End If
Wend
End Sub

Have Fun

Calacuccia

PS If you need more explanation, just shout
0
 

Author Comment

by:tkc
Comment Utility
Calacuccia

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:
NuLi=Source.Cells(1,1).SpecialCells(xlCellTypeLastCell).Row                      
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.

TKC
0
 
LVL 44

Expert Comment

by:bruintje
Comment Utility
hmmm...good answer and got no trouble running it here in Excel2000...
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 17

Accepted Solution

by:
calacuccia earned 200 total points
Comment Utility
Hi TKC,

To copy the entire title line, change the line (just after the EndBlock line)
Dest.Cells(j, 1) = Source.Cells(i, 1)
to
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.
http://support.microsoft.com/support/kb/articles/Q168/8/42.ASP
Maybe that applies to you ?

Cheers

Calacuccia
0
 

Author Comment

by:tkc
Comment Utility
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,
TKC
0
 
LVL 17

Expert Comment

by:calacuccia
Comment Utility
Thanks TKC

Glad you liked the program

Calacuccia
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Some time ago I was asked to create a VBA function that would calculate a check digit for an input number, using the following procedure: First, sum up all the individual digits in the number If that sum value has more than one digit, then sum up …
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…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …

743 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now