View Full Version : [SOLVED] Reformat Spreadsheet

10-22-2014, 06:06 AM
I have a spreadsheet that needs to be reformatted. The attached sample shows how the data came in columns A & B. Columns E through L show how it needs to be reformatted. Any assistance would be greatly appreciated.

10-22-2014, 07:29 AM
below procedure will work for 5 consecutive rows of data of same structure for a single vendor no.
so you should manually copy/paste Address2 and Phone values to columns I and L and delete their rows .

i picked a cell value which is common to all records, "Short Name", to distinguish between records.

below is the key to access each record's field info. that means i assume all fields of all records are in the same row order.


Benefits Brokers Exchange

Short Name:

Benefits B


1800 St. James Place, Ste. 650

Houston, TX


Sub reorg()

Const srcText As String = "Short Name"
Dim fCell As Range
Dim firstAddress As String
Dim LastRow As Long

With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set fCell = .Range("A2:A" & LastRow).Find(srcText)
If Not fCell Is Nothing Then
firstAddress = fCell.Address
.Range("D" & fCell.Row - 1).Value = fCell.Offset(-1, 0).Value
.Range("E" & fCell.Row - 1).Value = fCell.Offset(-1, 1).Value
.Range("F" & fCell.Row - 1).Value = fCell.Offset(0, 1).Value
.Range("G" & fCell.Row - 1).Value = fCell.Offset(-1, 1).Value
.Range("H" & fCell.Row - 1).Value = fCell.Offset(1, 1).Value
.Range("J" & fCell.Row - 1).Value = fCell.Offset(2, 0).Value
.Range("K" & fCell.Row - 1).Value = fCell.Offset(3, 0).Value
Set fCell = .Range("A2:A" & LastRow).FindNext(fCell)
Loop While Not fCell Is Nothing And fCell.Address <> firstAddress
End If
End With

End Sub

10-24-2014, 12:15 PM
Thank you so much for the help! Greatly appreciated.

10-24-2014, 04:33 PM
you are welcome. im glad it helped.