PDA

View Full Version : [SOLVED] Divide and Conquer



Slicemahn
12-18-2007, 06:28 AM
Hello Everyone,

I have been trying to arrange data in a way that can be updated to a database. To do so I would need to the data to be rearranged. I have over 32K rows in which the data is divided into three groups seperated by a blank line.

The data looks like the following

Wireless

Ottawa Montreal
Benjamin.Goody 123 0
George.Constanza 100 0
Jerry.Seinfeld 123 0
Cosmo.Kramer 0 123
Lloyd.Braun 0 100
Serenity.Now 0 130
.
.
.

VOIP

Ottawa Montreal
Elaine.Benace 0 112
David.Putty 0 123
Larry.David 0 100
Baboo.Bhatt 100 0
Jerry.Seinfeld 119 0

.
.

And there is another section similar. Using the first section, I want my output to be...

Benjamin.Goody 123 Ottawa Wireless
George.Constanza 100 Ottawa Wireless
Jerry.Seinfeld 123 Ottawa Wireless
Cosmo.Kramer 123 Montreal Wireless
Lloyd.Braun 100 Montreal Wireless
Serenity.Now 119 Montreal Wireless



I would appreciate any thoughts or suggestions.

Bob Phillips
12-18-2007, 07:01 AM
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Const OTTAWA_COLUMN As String = "D"
Const MONTREAL_COLUMN As String = "E"
Dim aryServices
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim Service As Long
Dim SaveService As Long
With ActiveSheet
aryServices = Array("Wireless", "VOIP", "Cable")
LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
NextRow = 0
For i = 1 To LastRow
If .Cells(i, TEST_COLUMN).Value <> "" Then
Service = 0
On Error Resume Next
Service = Application.Match(.Cells(i, TEST_COLUMN), aryServices, 0)
On Error GoTo 0
If Service > 0 Then
SaveService = Service
Else
If .Cells(i, OTTAWA_COLUMN).Value > 0 Then
NextRow = NextRow + 1
.Cells(i, TEST_COLUMN).Copy Worksheets("Sheet2").Cells(NextRow, "A")
.Cells(i, OTTAWA_COLUMN).Copy Worksheets("Sheet2").Cells(NextRow, "B")
Worksheets("Sheet2").Cells(NextRow, "C").Value = "Ottawa"
Worksheets("Sheet2").Cells(NextRow, "D").Value = aryServices(SaveService - 1 + LBound(aryServices))
End If
If .Cells(i, MONTREAL_COLUMN).Value > 0 Then
NextRow = NextRow + 1
.Cells(i, TEST_COLUMN).Copy Worksheets("Sheet2").Cells(NextRow, "A")
.Cells(i, MONTREAL_COLUMN).Copy Worksheets("Sheet2").Cells(NextRow, "B")
Worksheets("Sheet2").Cells(NextRow, "C").Value = "Montral"
Worksheets("Sheet2").Cells(NextRow, "D").Value = aryServices(SaveService - 1 + LBound(aryServices))
End If
End If
End If
Next i
End With
End Sub

Slicemahn
12-19-2007, 05:52 AM
Very nice. Thanks xld.