Combine and Transpose very slow

reds057 · Apr 19, 2022

I am constantly pulling data to review logs and how it comes out is undesirable. Instead of everything in 1 row and 6 columns, it spits each column out in a new row making for some of the data pulls 400k+ worth of lines. In some rows, it spits out the 4th and 5th line text into multiple columns.

Not much i can do about how i get the data since its a work tool. I created a macro to clean it up into a little more of a useable format but with the 400k worth of lines, it takes an hour or two to run. I am wondering what i am doing wrong or how to better what i wrote to speed this up?

So what i have going on here is combining all the text to column a from B:CA then deleting comments. next transpose rows to columns which starts by searching for the first blank which could be A400000. After everything is transposed, it deletes all blank above, and then adds in headers, cleans up spam lines and formats column size.

VBA is new to me and i am learning via google search and trials/errors. this error locked up my computer while running.

VBA Code:

Sub CombineValue()
    Dim N As Long, i As Long, j As Long
    N = Cells(Rows.Count, "a").End(xlUp).Row
   
    j = 2
    For i = 2 To N
       
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "b").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "c").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "d").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "e").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "f").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "g").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "h").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "i").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "j").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "k").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "l").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "m").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "n").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "o").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "p").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "q").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "r").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "s").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "t").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "u").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "v").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "w").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "x").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "y").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "z").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "aa").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ab").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ac").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ad").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ae").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "af").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ag").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ah").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ai").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "aj").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ak").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "al").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "am").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "an").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ao").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ap").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "aq").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ar").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "as").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "at").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "au").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "av").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "aw").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ax").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ay").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "az").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "ba").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bb").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bc").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bd").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "be").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bf").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bg").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bh").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bi").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bj").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bk").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bl").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bm").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bn").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bo").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bp").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bq").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "br").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bs").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bt").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bu").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bv").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bw").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bx").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "by").Value
        Cells(i, "A").Value = Cells(i, "A").Value & Cells(i, "bz").Value
       


    Next i
   
   
    Columns("B:BZ").Delete
   

     Dim rng As Range
    
    Set rng = Range("a1")
    While rng.Value <> ""
        i = i + 1
        rng.Resize(6).Copy
        Range("B" & i).PasteSpecial Transpose:=True
        Set rng = rng.Offset(6)
    Wend
    rng.EntireColumn.Delete
   
    Range("A1:E1").Value = Array("Date/Time", "Level", "Logger", "Arguments", "Procees")
   
    Set UsedRng = ActiveSheet.UsedRange
    LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
    Application.ScreenUpdating = False
 
    For RowIndex = LastRowIndex To 1 Step -1
        If Application.CountA(Rows(RowIndex)) = 0 Then
            Rows(RowIndex).Delete
        End If
    Next RowIndex
 
    Application.ScreenUpdating = True
   
    Columns("A").ColumnWidth = 18.57
    Columns("B").ColumnWidth = 13.57
    Columns("C").ColumnWidth = 14.86
    Columns("D").ColumnWidth = 208.86
   
    With ActiveSheet
    .AutoFilterMode = False
    With Range("d1", Range("d" & Rows.Count).End(xlUp))
        .AutoFilter 1, "*can::drv[1]: tx full count*"
        On Error Resume Next
        .Offset(1).SpecialCells(12).EntireRow.Delete
    End With
    .AutoFilterMode = False
    .AutoFilterMode = False
    With Range("d1", Range("d" & Rows.Count).End(xlUp))
        .AutoFilter 1, "*can::drv[0]: tx full count*"
        On Error Resume Next
        .Offset(1).SpecialCells(12).EntireRow.Delete
    End With
    .AutoFilterMode = False
End With
End Sub

Fluff · Apr 19, 2022

Hi & welcome to MrExcel.
As you are using 365 you can replace everything in that 1st loop with

VBA Code:

    For i = 2 To N
       Cells(i, "A").Value = Application.Concat(Cells(i, 1).Resize(, 78))
    Next i

Fluff · Apr 19, 2022

I take it that the change I suggested worked.
Do you want further improvements?

reds057 · Apr 20, 2022

Yes Thank You! it did help and easier to manage vs typing all those lines out. i also change the transpose which now completes the task in about 2 minutes vs 2 hours. I just need to work on something now to to find and remove lines based on some keys words to lessen the lines to a readable format.

VBA Code:

Sub TransposeRows1()

    Dim N As Long, i As Long, j As Long
    N = Cells(Rows.Count, "a").End(xlUp).Row
    
    j = 2
    For i = 2 To N
       Cells(i, "A").Value = Application.Concat(Cells(i, 1).Resize(, 78))
    Next i
  
    Columns("B:BZ").Delete
    Dim k&, z&, x&
    Set rng = Range("a1")
    k = Cells(Rows.Count, "A").End(xlUp).Row
    z = 1: x = 1
    While z <= i
        Range("B" & x).Resize(, 6) = _
            WorksheetFunction.Transpose(Range("A" & z).Resize(6))
        z = z + 6: x = x + 1
    Wend
    rng.EntireColumn.Delete
    
    Range("A1").EntireRow.Insert
    Range("A1:E1").Value = Array("Date/Time", "Level", "Logger", "Arguments", "Procees")

    Columns("A").ColumnWidth = 18.57
    Columns("B").ColumnWidth = 13.57
    Columns("C").ColumnWidth = 14.86
    Columns("D").ColumnWidth = 208.86

End Sub

Fluff · Apr 20, 2022

You could also get rid of the while.wend loop using an array which should be faster

VBA Code:

   Dim N As Long, i As Long, j As Long, nr As Long
   Dim Ary As Variant, Nary As Variant
   
   Application.ScreenUpdating = False
   N = Cells(Rows.Count, "a").End(xlUp).Row
   
   For i = 2 To N
      Cells(i, "A").Value = Application.Concat(Cells(i, 1).Resize(, 78))
   Next i
   Columns("B:BZ").Delete
   
   Ary = Range("A1").Resize(N).Value2
   ReDim Nary(1 To N, 1 To 6)
   For i = 1 To N Step 6
      nr = nr + 1
      For j = 1 To 6
         Nary(nr, j) = Ary(i + j - 1, 1)
      Next j
   Next i
   Range("B2").Resize(nr, 6).Value = Nary
   Range("A:A").EntireColumn.Delete
   
    Range("A1:E1").Value = Array("Date/Time", "Level", "Logger", "Arguments", "Procees")
    Columns("A").ColumnWidth = 18.57
    Columns("B").ColumnWidth = 13.57
    Columns("C").ColumnWidth = 14.86
    Columns("D").ColumnWidth = 208.86

reds057 · Apr 20, 2022

thank you. it helped speed up a little bit which at this point, i will take any extra time that i can get.

Fluff · Apr 20, 2022

You're welcome & thanks for the feedback.

Combine and Transpose very slow

reds057

New Member

Attachments

Excel Facts

Fluff

MrExcel MVP, Moderator

Fluff

MrExcel MVP, Moderator

reds057

New Member

Fluff

MrExcel MVP, Moderator

reds057

New Member

Fluff

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Combine and Transpose very slow

reds057

New Member

Attachments

Excel Facts

Fluff

MrExcel MVP, Moderator

Fluff

MrExcel MVP, Moderator

reds057

New Member

Fluff

MrExcel MVP, Moderator

reds057

New Member

Fluff

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock