Speed up Macro/using power query?

[sblair9691]

Hi All,
I am currently using code to split data from a single column (copied from pdf) to separate columns for easy reading. There are over 5000 entries within the spreadsheet and it is slow to complete the macro. Does anyone have any tips for speeding this up or using powerquery instead? I've attached an output example and the code.
Thank you in advance.

My Code:

Sub SelectBetween()
   Dim LastRow As Long, i As Long
   Dim x As Long
    Dim y As Long
   x = 1
   y = 2
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
     i = 1
      Dim findrow As Long, findrow2 As Long
findrow = Range("A:A").Find("Animal", Range("A1")).Row
    findrow2 = Range("A:A").Find("Animal", Range("A" & findrow)).Row
    Range("A" & findrow & ":A" & findrow2 - 1).Select
    Selection.Cut
Cells(x, y).Select
y = y + 1
ActiveSheet.Paste
   Next i
End Sub

What i want to happen:

Animal		Animal	Animal	Animal	Animal
Dog		Dog	Dog	Cat	Cat
Cat		Cat		Ardvark	Pigeon
Person		Person		Dog
Animal
Dog
Animal
Cat
Ardvark
Dog
Animal
Cat
Pigeon
Animal

 

[RoryA]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

How to speed up VBA/Use powerquery instead?

Hi All, I am currently using code to split data from a single column (copied from pdf) to separate columns for easy reading. There are over 5000 entries within the spreadsheet and it is slow to complete the macro. Does anyone have any tips for speeding this up or using powerquery instead? I've...

www.excelforum.com

If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[JGordon11]

My PQ attempt works for small data sets, but is too slow for larger ones. I won't bother posting it here. The vba function below requires the Rng input data to be in a single column with the header in the first and last row as in your example. I tested it on a 10000 row range and it was essentially instantaneous.

Function ListToTable(Rng As Range) As Variant
    Dim i As Long, Data, ubd As Long, k As Long, diffmax As Long, j As Long, Header As String, t As Double
    t = Timer: Data = Rng: ubd = UBound(Data): Header = Data(1, 1)
    For i = 2 To ubd
        If Data(i, 1) <> Header Then
            k = k + 1
        Else
            If k > diffmax Then diffmax = k
            k = 0
        End If
    Next
    If k > diffmax Then diffmax = k
    ReDim A(1 To diffmax + 1, 1 To Application.CountIf(Rng, Header) - 1) As String
    A(1, 1) = Header
    k = 1
    j = 2
    For i = 2 To ubd - 1
        If Data(i, 1) <> Header Then
            A(j, k) = Data(i, 1)
            j = j + 1
        Else
            k = k + 1
            j = 2
            A(1, k) = Header
        End If
    Next
    ListToTable = A
    Debug.Print ubd & " items in " & Round(Timer - t, 3) & " second"
End Function

 

[citizenbh]

Try this:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}}),
    #"Renamed Columns" = Table.RenameColumns(#"Changed Type",{{"Column1", "An"}}),
    #"Added Custom" = Table.AddColumn(#"Renamed Columns", "FindAn", each if [An]="Animal" then "Animal" else null),
    #"Added Index" = Table.AddIndexColumn(#"Added Custom", "Index", 0, 1, Int64.Type),
    #"Changed Type1" = Table.TransformColumnTypes(#"Added Index",{{"Index", type text}}),
    Join = Table.AddColumn(#"Changed Type1", "Num_Animal", each [FindAn]&[Index]),
    #"Filled Down" = Table.FillDown(Join,{"Num_Animal"}),
    #"Removed Columns" = Table.RemoveColumns(#"Filled Down",{"FindAn", "Index"}),
    Group = Table.Group(#"Removed Columns", {"Num_Animal"}, {{"No", each Table.RowCount(_), type number},{"Items", each _, type table [An=nullable text, Num_Animal=text]}}),
    List = Table.AddColumn(Group, "An", each [Items][An]),
    Extract = Table.TransformColumns(List, {"An", each Text.Combine(List.Transform(_, Text.From), ","), type text}),
    Split = Table.SplitColumn(Extract, "An", Splitter.SplitTextByAnyDelimiter({","}, QuoteStyle.Csv),List.Max(Group[No])),
    #"Removed Columns1" = Table.RemoveColumns(Split,{"Num_Animal", "No", "Items"}),
    #"Transposed Table" = Table.Transpose(#"Removed Columns1"),
    #"Promoted Headers" = Table.PromoteHeaders(#"Transposed Table", [PromoteAllScalars=true]),
    #"Changed Type2" = Table.TransformColumnTypes(#"Promoted Headers",{{"Animal", type text}, {"Animal_1", type text}, {"Animal_2", type text}, {"Animal_3", type text}, {"Animal_4", type any}})
in
    #"Changed Type2"

 

[lrobbo314]

Essentially the same thing as @citizenbh, just a slightly different way of getting there.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Index = Table.AddIndexColumn(Source, "Index", 1, 1, Int64.Type),
    GI = Table.AddColumn(Index, "Custom", each List.Count(List.Select(List.FirstN(Index[Column1],[Index]),each _ = "Animal"))),
    Group = Table.Group(GI, {"Custom"}, {{"Count", each _, type table [Column1=text, Index=number, Custom=number]}}),
    TC = Table.TransformColumns(Group,{{"Count", each Text.Combine(_[Column1],",")}}),
    Split = Table.SplitColumn(TC, "Count", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv)),
    RC = Table.RemoveColumns(Split,{"Custom"}),
    Transpose = Table.Transpose(RC),
    Promote = Table.PromoteHeaders(Transpose, [PromoteAllScalars=true])
in
    Promote