Code/Formula to sort large amounts of data

[chrisellis250]

Hello,

I have done something similar in the past, where I would paste a large amount of data into a spreadsheet and then using coding and/or a formula to sort the data into a more organised way etc. However, I am unsure how to do it and what is the best way to do it?

A sample spreadsheet is attached.

Any help is much appreciated.

Many thanks as always.

[Glenn Kennedy]

These are all array formulae. 7

In A2, copied down:
=IFERROR(INDEX('Paste Data'!$A:$A,SMALL(IF(LEFT('Paste Data'!$A$1:$A$21,6)="Phone:",ROW('Paste Data'!$A$1:$A$21)-2),ROWS(A$2:A2))),"")

In B2, copied across to D2 and then down:
=IFERROR(TRIM(MID(SUBSTITUTE(","&INDEX('Paste Data'!$A:$A,SMALL(IF(LEFT('Paste Data'!$A$1:$A$21,6)="Phone:",ROW('Paste Data'!$A$1:$A$21)-1),ROWS(B$2:B2))),",",REPT(" ",125)),125*COLUMNS($A:A),125)),"")

In E2, copied down:
=IFERROR(MID(INDEX('Paste Data'!$A:$A,SMALL(IF(LEFT('Paste Data'!$A$1:$A$21,6)="Phone:",ROW('Paste Data'!$A$1:$A$21)),ROWS(E$2:E2))),8,255),"")

Array Formulae are a little different from ordinary formulae in that they MUST be confirmed in the FIRST CELL ONLY by pressing CTRL+SHIFT+ENTER to activate the array, not just ENTER. After that, the array can be dragged down as normal, to cover the desired range.

You will know the array is active when you see curly brackets { } - or "curly braces" for those of you in the USA, or "flower brackets" for those of you in India - appear around the outside of your formula. If you do not use CTRL+SHIFT+ENTER you will (almost always) get an error message or an incorrect answer. Press F2 on that cell and try again.

Don't type the curly brackets yourself - it won't work...

[JOHN H. DAVIS]

A macro alternative:

Sub chrisellis250()
Dim i As Long, y, textrange As Range
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
Rows(1).Insert
Cells(1, "A") = "Business Name"
Cells(1, "B") = "Street"
Cells(1, "C") = "City"
Cells(1, "D") = "State"
Cells(1, "E") = "Telephone"
ReDim y(2 To Range("A" & Rows.Count).End(3).row)
For i = UBound(y) To LBound(y) Step -1
    If Cells(i, "A") Like "*eview*" Then Rows(i).Delete
    If Cells(i, "A") Like "*Phone*" Then Rows(i + 1).Insert
Next i
Rows(2).Insert
For Each textrange In Range("A2:A" & Range("A" & Rows.Count).End(3).row).SpecialCells(2, 2).Areas
    addr = textrange.Address(False, False)
    For i = 2 To 3
    Select Case i
        Case Is = 2
            Range(addr).Item(i, 1).Copy Range(addr).Item(i, 2)
            Range(addr).Item(i, 2).TextToColumns Range(addr).Item(i, 2), xlDelimited, xlDoubleQuote, False, True, False, False, False, True, ","
        Case Is = 3
            Range(addr).Item(i, 1).Copy Range(addr).Item(i, 5)
    End Select
    Next i
    With Range(addr)
        .Resize(, 5).SpecialCells(4).Delete xlUp
        .Offset(1).Resize(3, 5).Delete xlUp
    End With
Next textrange
Rows(2).Delete
Columns(1).Resize(, 5).EntireColumn.AutoFit
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub