Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1419
  • Last Modified:

Using VBA to consolidate a Excel worksheet

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
tkc
Asked:
tkc
  • 3
  • 2
1 Solution
 
calacucciaCommented:
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
 
tkcAuthor Commented:
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
 
bruintjeCommented:
hmmm...good answer and got no trouble running it here in Excel2000...
0
NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

 
calacucciaCommented:
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
 
tkcAuthor Commented:
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
 
calacucciaCommented:
Thanks TKC

Glad you liked the program

Calacuccia
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now