Combine and Transpose very slow

R

reds057

New Member
Joined
Apr 19, 2022
Messages
3
Office Version
  1. 365
Platform
  1. Windows
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
 

Attachments

  • 2022-04-19_8-07-36.jpg
    2022-04-19_8-07-36.jpg
    230.8 KB · Views: 21
  • 2022-04-19_8-05-43.jpg
    2022-04-19_8-05-43.jpg
    128.6 KB · Views: 16

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
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
 
Upvote 0
I take it that the change I suggested worked.
Do you want further improvements?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Solution
thank you. it helped speed up a little bit which at this point, i will take any extra time that i can get.
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
create fixtures but 2 vs 2
Replies
7
Views
151
kerm007
K
D
  • Solved
Error 1004
2
Replies
18
Views
278
dmt32
D
A
  • Solved
Could not set the RowSource property. Invalid property value. Error 380
2
Replies
16
Views
153
RoryA
RoryA
D
  • Solved
Numeric Value returned when Time format returned to User Form TextBox
Replies
3
Views
47
6StringJazzer
6StringJazzer
D
  • Question Question
Possible Use of CountIF and AVERAGE Functions
Replies
1
Views
79
Denny57
D

Forum statistics

Threads
1,223,249
Messages
6,171,031
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top