Convert data to array

G

GeraldM

Would appreciate help with the following problem:

I have data in two columns - "Make" & "Model"
I need to convert the into an array with:
1) a column for each "Make"
2) each model in the correct column.

Example:

Change the data from that shown below: (Note: The number of "Makes" is not
limited to three).

Make Model
------- ----------
Ford Falcon
Ford Focus
Ford Fiesta
Ford Mondeo
Ford Anglia
Holden Commodore
Holden Torrano
Holden Monarro
Holden Astra
Kia Rio
Kia Carnival


Need to change the data to look like below: (Note: I need to automate this
(using VBA) for others to use, so I don't want to manually transpose the
data).

Ford Holden Kia
-------- ------------- -----------
Falcon Commodore Rio
Focus Torrano Carnival
Fiesta Monarro
Mondeo Astra
Anglia
 
J

Joel

The code does almost everything but creates the original data. Just set the
first three lines of code to the correct Rows and columns and the code does
the rest. the code assumes the original data is in sheet 1 and the new data
is created iin sheet 2. You can change the names of the sheets as required.
the code has been fully tested.

the code searches row 1 of sheet 2 to find the Make of the automobiles. If
it finds the Make it adds the model to the end of the list. If it doesn't
find the Make it adds it to the header Row on Sheet 2 and addss the Model to
the first Row.


Sub make_table()

Sh1StartRow = 1 'first row of data after header
Sh2FirstRow = 2 'leave at least one row for headers
Sh2NewCol = 1 'enter column where you want data to start

Sh1RowCount = Sh1StartRow
With Sheets("Sheet1")
Do While .Range("A" & Sh1RowCount) <> ""
Make = .Range("A" & Sh1RowCount)
Model = .Range("B" & Sh1RowCount)
With Sheets("Sheet2")
Set c = .Rows(1).Find(what:=Make, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Cells(1, Sh2NewCol) = Make
.Cells(Sh2FirstRow, Sh2NewCol) = Model
Sh2NewCol = Sh2NewCol + 1
Else
LastRow = .Cells(Rows.Count, c.Column).End(xlUp).Row
.Cells(LastRow + 1, c.Column) = Model
End If
End With
Sh1RowCount = Sh1RowCount + 1
Loop
End With
End Sub
 
G

GeraldM

Thanks Joel.
Works perfectly.

Regards: Gerald

Joel said:
The code does almost everything but creates the original data. Just set the
first three lines of code to the correct Rows and columns and the code does
the rest. the code assumes the original data is in sheet 1 and the new data
is created iin sheet 2. You can change the names of the sheets as required.
the code has been fully tested.

the code searches row 1 of sheet 2 to find the Make of the automobiles. If
it finds the Make it adds the model to the end of the list. If it doesn't
find the Make it adds it to the header Row on Sheet 2 and addss the Model to
the first Row.


Sub make_table()

Sh1StartRow = 1 'first row of data after header
Sh2FirstRow = 2 'leave at least one row for headers
Sh2NewCol = 1 'enter column where you want data to start

Sh1RowCount = Sh1StartRow
With Sheets("Sheet1")
Do While .Range("A" & Sh1RowCount) <> ""
Make = .Range("A" & Sh1RowCount)
Model = .Range("B" & Sh1RowCount)
With Sheets("Sheet2")
Set c = .Rows(1).Find(what:=Make, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Cells(1, Sh2NewCol) = Make
.Cells(Sh2FirstRow, Sh2NewCol) = Model
Sh2NewCol = Sh2NewCol + 1
Else
LastRow = .Cells(Rows.Count, c.Column).End(xlUp).Row
.Cells(LastRow + 1, c.Column) = Model
End If
End With
Sh1RowCount = Sh1RowCount + 1
Loop
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top