Re-organization of data

[po2206]

Hi

I need to analyze some shipment data that is not currently in a format
suitable for analysis.

My shipment data consists of a shipment no., basic freight charge, fuel
surcharge, customs fee etc. The problem is that each charge is specified
on a separate line. This means that data about each shipment is covering
several lines in my spreadsheet. To sum up column A contains shipment
no. Column B: Charge type. Column C: Charge cost.

I would like the data to be structured so each shipment covers only one
row, and each individual charge type has its own column.

Any ideas on how to achieve this?

 

[Ardus Petus]

The following example might help:
http://cjoint.com/?dkpSQR4ql5

The formula in sheet2 is:
=OFFSET(Feuil1!R1C1,(ROW()-1)*4+(COLUMN()-1),0)

HTH

 

[po2206]

Thanks.
Unfortunately the charges for each shipment are not standard. Therefore
one shipment might only have one charge, while others could have three
or four (and take up three or four rows).

That rules out your suggestion if I understand it correctly.

 

[Ardus Petus]

Is there some way you can tell the first line of a shipment from others?

Please post some example.

HTH

 

[po2206]

The first line of each shipment is characterised by a new shipment no.
Each shipment no. is unique.

The three columns of data look like this:

SHIPMENT NO. COST TYPE CHARGE
2143214432 Freight 23
2143214432 Fuel charge 2
2143214432 Customs fee 10
4342342342 Freight 43
4342342342 Fuel charge 4
8734343254 Freight 62
8734343254 Fuel charge 5

 

[Ardus Petus]

Copy the following code into a Module.
Adjust worksheets names in Const lines (at the beginning)

I split the code into 2 macros:
1) CreateDestWS: creates the dest worksheet and populates column headers
2) MoveData : mouve data from source to dest WS

If anything goes wrong, please post back.

HTH
--
AP

'------------------------------------------
Const srcWsName As String = "Sheet1"
Const destWsName As String = "Sheet2"

Sub createDestWS()
Dim rngSrcHeaders As Range
Dim rngDestHeaders As Range
Dim strColAHeader As String
With Worksheets(srcWsName)
strColAHeader = .Range("A1").Value
Set rngSrcHeaders = .Range( _
.Range("B1"), _
.Cells(Rows.Count, "B").End(xlUp) _
)
End With
' Create dest WS if does not exist
On Error Resume Next
If Worksheets(destWsName) Is Nothing Then
With Worksheets.Add(after:=Worksheets(Worksheets.Count))
.Name = destWsName
End With
End If
On Error GoTo 0

With Worksheets(destWsName)
' Clear contents if any
.UsedRange.ClearContents
' Filter out uique values for col headers
rngSrcHeaders.AdvancedFilter _
action:=xlFilterCopy, _
copytorange:=.Range("A1"), _
unique:=True
' Traspose vertical list into horizontal Col headers
Set rngDestHeaders = .Range( _
"A2", _
.Cells(Rows.Count, "A").End(xlUp) _
)
rngDestHeaders.Copy
.Range("B1").PasteSpecial _
Paste:=xlPasteValues, _
operation:=xlNone, _
Transpose:=True
rngDestHeaders.ClearContents
' Set header for col A
.Range("A1").Value = strColAHeader
End With
End Sub

Sub moveData()
Dim srcRng As Range
Dim destRng As Range
Dim headersRng As Range
Dim iCol As Long

' Initialize
Set srcRng = Worksheets(srcWsName).Range("A2")
With Worksheets(destWsName)
Set destRng = .Range("A1")
Set headersRng = .Range( _
"B1", _
.Cells(1, Columns.Count).End(xlToRight) _
)
End With
Do While srcRng.Value <> ""
If srcRng.Value <> srcRng.Offset(-1, 0).Value Then
Set destRng = destRng.Offset(1, 0)
' Copy shipment no.
destRng.Value = srcRng.Value
End If
' Search source charge type thru dest headers
iCol = Application.WorksheetFunction.Match( _
srcRng.Offset(0, 1).Value, _
headersRng, _
0)
' Copy source charge value into dest column
destRng.Offset(0, iCol).Value = _
srcRng.Offset(0, 2)
'End of loop: Skip to next source row
Set srcRng = srcRng.Offset(1, 0)
Loop
End Sub
'----------------------------------------------------------------

 

[po2206]

Brilliant! It works and is exactly what I was looking for.
Thanks a lot

 

[Ardus Petus]

Thanks for the feedback.

Cheers,