Convert a list into rows

[Colmans]

Hi

I've downloaded some data which comprises of business name, address and post/zip code. The data has arrived in a single column but I now need to sort so that I can effectively swivel the company data 90 degrees so each business lists across a row.

Not all of the data is consistent as some have more address lines than others.

I've tried to run simple macro by recording the actions, but it links this to the original cells, and not from my current starting point.

Any advice or ideas to help me speed this up would be appreciated, and thanks in advance for your help.

 

[alansidman]

Suggest you post about a dozen lines of sample data that is representative of your actual data. Without seeing any data, it is difficult to offer any type of solution for this type of issue.

 

[Colmans]

Company A

The High Street

Big Town

AA1 3AA

Company B

The Mews

Main Road

Little Town

AA5 5AA

Company C

3 Market Square

Big Town

AA1 3ZZ All of the above is in column A

<tbody>
</tbody>

And convert to

Company A	The High Street	Big Town	AA1 3AA
Company B	The Mews	Main Road	Little Town	AA5 5AA
Company C	3 Market Square	Big Town	AA1 3ZZ

<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[Yongle]

EDIT - just spotted that you have posted some data


Name and address lists are notoriously inconsistent and error prone so I endeavour to FIX data layout to make it more consistent BEFORE trying to transpose anything most of which can generally be achieved with VBA

To help we need to know a bit more about your data and in particular any patterns that can be identified

- Is the first cell usually the name?
- Is the last cell usually the zip code?
- Is the cell above the zip code usually the city?
- Is there a blank cell
- Is there a marker to identify the beginning (or end) of each block (please provide details)
- are there any blank cells within "address blocks"
- are all addresses US addresses?
- any obvious oddballs?
- how many rows are there?

Ideally each "address" is a contiguous block (no empty cells) ...followed by an empty cell
see worksheet below where name is consistently the FIRST cell and zip code consistently the LAST cell of block

<tbody>
</tbody>

Excel 2016 (Windows) 32 bit

	A​
1​
2​	Name1
3​	addr1 1
4​	addr1 2
5​	City 1
6​	zip1
7​
8​	Name2
9​	addr2 1
10​	addr2 2
11​	City 2
12​	zip2
13​
14​	Name3
15​	addr3 1
16​	addr3 2
17​	addr3 3
18​	City 3
19​	zip3
20​
21​	name4
22​	addr4 1
23​	City 4
24​	zip1
25​

Sheet: List

 

[Yongle]

That data in post#3 does not look like a typical UK adddress list (no counties??? etc)
- simplifying to that extent may be unhelpful

We need to understand what the actual data looks like (warts and all)
- see questions on previous post

Please confirm that you simply want the data form each row to go into the next column and not have all postcodes in one column etc

thanks

 

[sandy666]

with PowerQuery (Get&Transform)

raw		Company	Address.1	Address.2	Address.3	Address.4
Company A		Company A	The High Street	Big Town	AA1 3AA
The High Street		Company B	The Mews	Main Road	Little Town	AA5 5AA
Big Town		Company C	3 Market Square	Big Town	AA1 3ZZ
AA1 3AA
Company B
The Mews
Main Road
Little Town
AA5 5AA
Company C
3 Market Square
Big Town
AA1 3ZZ

[SIZE=1]// Table1
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Condition = Table.AddColumn(Source, "Company", each if Text.Contains([raw], "Company") then [raw] else null),
    FillD = Table.FillDown(Condition,{"Company"}),
    Filter = Table.SelectRows(FillD, each not Text.Contains([raw], "Company")),
    Group = Table.Group(Filter, {"Company"}, {{"Count", each _, type table}}),
    List = Table.AddColumn(Group, "Address", each Table.Column([Count],"raw")),
    Extract = Table.TransformColumns(List, {"Address", each Text.Combine(List.Transform(_, Text.From), ","), type text}),
    SplitCount = Table.AddColumn(Extract, "Split Count", each List.Count(Text.Split([Address],","))),
    MaxCount = List.Max(SplitCount[Split Count]),
    Split = Table.SplitColumn(Extract, "Address", Splitter.SplitTextByDelimiter(","), MaxCount)
in 
    Split[/SIZE]

 

[Colmans]

That data in post#3 does not look like a typical UK adddress list (no counties??? etc)
- simplifying to that extent may be unhelpful

We need to understand what the actual data looks like (warts and all)
- see questions on previous post

Please confirm that you simply want the data form each row to go into the next column and not have all postcodes in one column etc

thanks

Yongle

The data I listed is how the data is. It is very basic and it is for UK addresses and is taken from a public data. I'm not concerned about all of the post codes being in the same column as I can easily adress that after.

 

[Yongle]

If you are happy with a VBA solution ....

The function below will ultimately be called from another VBA procedure if it works as expected when you test it


First of all give this a try in a copy of your workbook
- it is a starting point to help identify the END of each address block
- the formula in column B should return nothing except where there is a valid postcode in the adjacent cell in column A

All you need do is ...
1. insert the code (see below)
2. then use this formula in B1 copied down
=IFERROR(ValidatePostCode(A1),"")

Place code in a STANDARD VBA module (see notes below)

Function ValidatePostCode(ByVal PostCode As String)
'datanology UK Postcode Validator
Dim Parts() As String
PostCode = UCase$(PostCode)
Parts = Split(PostCode)
If PostCode = "GIR 0AA" Or PostCode = "SAN TA1" Or _
(Parts(1) Like "#[A-Z][A-Z]" And _
(Parts(0) Like "[A-Z]#" Or _
Parts(0) Like "[A-Z]#[0-9A-Z]" Or _
Parts(0) Like "[A-Z][A-Z]#" Or _
Parts(0) Like "[A-Z][A-Z]#[0-9A-Z]")) Then
ValidatePostCode = (Parts(0) Like "[BEGLMSW]#*" Or _
Parts(0) Like "A[BL]#*" Or _
Parts(0) Like "B[ABDHLNRST]#*" Or _
Parts(0) Like "C[ABFHMORTVW]#*" Or _
Parts(0) Like "D[ADEGHLNTY]#*" Or _
Parts(0) Like "E[CHNX]#*" Or _
Parts(0) Like "F[KY]#*" Or _
Parts(0) Like "G[LU]#*" Or _
Parts(0) Like "H[ADGPRSUX]#*" Or _
Parts(0) Like "I[GPV]#*" Or _
Parts(0) Like "K[ATWY]#*" Or _
Parts(0) Like "L[ADELNSU]#*" Or _
Parts(0) Like "M[EKL]#*" Or _
Parts(0) Like "N[EGNPRW]#*" Or _
Parts(0) Like "O[LX]#*" Or _
Parts(0) Like "P[AEHLOR]#*" Or _
Parts(0) Like "R[GHM]#*" Or _
Parts(0) Like "S[AEGKLMNOPRSTWY]#*" Or _
Parts(0) Like "T[ADFNQRSW]#*" Or _
Parts(0) Like "W[ACDFNRSV]#*" Or _
Parts(0) Like "UB#*" Or _
Parts(0) Like "YO#*" Or _
Parts(0) Like "ZE#*")
End If
If ValidatePostCode Then
ValidatePostCode = "Valid"
Else
ValidatePostCode = ""
End If
End Function

Notes
visit VBA window with {ALT}{F11}
Insert a new Module with {ALT} I M
Paste code into that window (ensure EVERYTHING up to and including End Function is copied)
return to Excel with {ALT}{F11}

 

[Yongle]

The VBA below (which uses the function provided in post#8) creates a new sheet containing the transposed data as requested
- your sample data contained a UK postcode as the last line of each address block
- that pattern determines each range copied and transposed
- rows containing blank cells in column A are deleted early in the code

Test on a COPY of your workbook

The "dummy" postcodes in your sample data were replaced with valid UK postcodes and the sheet named "List"
Sample data used
Excel 2016 (Windows) 32 bit

	A​
1​
2​	Company A
3​	The High Street
4​	Big Town
5​	LL30 3AA
6​	Company B
7​	The Mews
8​	Main Road
9​	Little Town
10​	CA27 5AA
11​	Company C
12​	3 Market Square
13​	Big Town
14​	E1 7DP
15​

Sheet: List

Running TransposeAdresses returned this

Excel 2016 (Windows) 32 bit

	A​	B​	C​	D​	E​
1​
2​	Company A	The High Street	Big Town	LL30 3AA
3​	Company B	The Mews	Main Road	Little Town	CA27 5AA
4​	Company C	3 Market Square	Big Town	E1 7DP
5​

Sheet: Sheet11

Place code below in standard module
Function ValidatePostCode required
- amend the sheet name (List) and first cell (A2) as appropriate

Sub TransposeAdresses()
    Dim aName As Range, Last As Range, Block As Range, Cel As Range
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Sheets("[I][COLOR=#ff0000]List[/COLOR][/I]")
    ws1.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Set ws2 = Sheets.Add: ws2.Range("A:G").ColumnWidth = 30
    Set Last = ws1.Range("A" & Rows.Count).End(xlUp)            'last cell with value in column A
    Set aName = ws1.Range("[I][COLOR=#ff0000]A2[/COLOR][/I]")                                 'first cell

    Do
'find next cell containing postcode
        Set Cel = aName                                         'begin with first cell
        Do Until ValidatePostCode(Cel) = "Valid"                'does it contain a postcode?
            Set Cel = Cel.Offset(1)                             'try next cell
            If Cel.Address = Last.Address Then Exit Do          'stop at last cell with value
        Loop
'set address block, copy and paste transposed
        Set Block = Range(aName, Cel)
        Block.Copy
        With ws2.Range("A" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial xlPasteAll, Transpose:=True
        End With
'move to next name
        Set aName = Block.Offset(Block.Rows.Count).Resize(1)
        If aName = "" Then Exit Do                              'stop if cell is blank
    Loop
End Sub