Macros are VERY slow to run

[wxtoad]

I think it's because when each function is executed, it goes all the way down to bottom of the spreadsheet, well beyond the last row data. When I look at the sheet after executing a function, it has placed a "0" in all cells in the column below the data. Then when the next function executes, it goes all the way down to the bottom and attempts to do something with the "0"s.

My sheet contains only 27,000 rows. Is there some way to limit calculations to only those rows and no further into the blank portion of the sheet?
I record the macros - so far VBA is beyond my skill set.

Thanks,


WxToad

[excelledsoftware]

It sounds like your macro may be selecting each of the cells. It also sounds like it does not quite know when to stop. This can definitely be sped up. Can you post the code you have so far or a sample book with the desired result.

[wxtoad]

This was done by recording the steps. In executing the macro, the screen often goes white, a message saying Excel not responding repeatedly appears, and it took about 10 minutes to complete.

This same macro worked fine with my former Excel 2003, but 2013 is a problem.

As to what I'm trying to accomplish with this particular process is to add 1 or 2 leading zeros to a series of numbers in a string; i.e., convert this:

3,5,6,8,9,12,14

to this:

003,005,006,008,009,012,014

There is undoubtedly an easier way, and I guess I need to buckle down and learn VBA so I can write the macro.

The over-arching issue, though, is limiting the function to just the populated rows and not the entire sheet.

Thanks for your assistance.

Sub Activities()
'
' Activities Macro
'
' Keyboard Shortcut: Ctrl+a
'
    Columns("T:T").Select
    Selection.Copy
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 34
    ActiveWindow.ScrollColumn = 35
    ActiveWindow.ScrollColumn = 36
    ActiveWindow.ScrollColumn = 37
    ActiveWindow.ScrollColumn = 39
    ActiveWindow.ScrollColumn = 41
    ActiveWindow.ScrollColumn = 42
    ActiveWindow.ScrollColumn = 41
    ActiveWindow.ScrollColumn = 40
    ActiveWindow.ScrollColumn = 39
    ActiveWindow.ScrollColumn = 37
    ActiveWindow.ScrollColumn = 36
    ActiveWindow.ScrollColumn = 35
    ActiveWindow.ScrollColumn = 36
    Columns("AN:AN").Select
    ActiveSheet.Paste
    Columns("AN:BP").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "General"
    Range("AN1").Select
    Selection.ClearContents
    Columns("AN:AN").Select
    Selection.TextToColumns Destination:=Range("AN1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 35
    ActiveWindow.ScrollColumn = 37
    ActiveWindow.ScrollColumn = 40
    ActiveWindow.ScrollColumn = 43
    ActiveWindow.ScrollColumn = 44
    ActiveWindow.ScrollColumn = 45
    ActiveWindow.ScrollColumn = 46
    ActiveWindow.ScrollColumn = 47
    ActiveWindow.ScrollColumn = 48
    Range("AX1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-10]="""","""",IF(LEN(RC[-10])=2,CONCATENATE(""0"",RC[-10]),CONCATENATE(""00"",RC[-10])))"
    Columns("AX:AX").Select
    Selection.FillDown
    Range("AX1").Select
    Selection.Copy
    Range("AY1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("AY:AY").Select
    Selection.FillDown
    Range("AY1").Select
    Selection.Copy
    Range("AZ1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("AZ:AZ").Select
    Selection.FillDown
    Range("AZ1").Select
    Selection.Copy
    Columns("BA:BA").Select
    Application.CutCopyMode = False
    Selection.FillDown
    Range("AZ1").Select
    Selection.Copy
    Range("BA1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BA:BA").Select
    Selection.FillDown
    Range("BA1").Select
    Selection.Copy
    Range("BB1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BB:BB").Select
    Selection.FillDown
    Range("BB1").Select
    Selection.Copy
    Range("BC1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BC:BC").Select
    Selection.FillDown
    Range("BC1").Select
    Selection.Copy
    Range("BD1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BD:BD").Select
    Selection.FillDown
    Range("BD1").Select
    Selection.Copy
    Range("BE1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BE:BE").Select
    Selection.FillDown
    Range("BE1").Select
    Selection.Copy
    Range("BF1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BF:BF").Select
    Selection.FillDown
    Range("BF1").Select
    Selection.Copy
    Range("BG1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BG:BG").Select
    Selection.FillDown
    Range("BI1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-11]="""","""",CONCATENATE(RC[-11],"",""))"
    Columns("BI:BI").Select
    Selection.FillDown
    ActiveWindow.ScrollColumn = 47
    ActiveWindow.ScrollColumn = 48
    ActiveWindow.ScrollColumn = 49
    ActiveWindow.ScrollColumn = 50
    ActiveWindow.ScrollColumn = 51
    ActiveWindow.ScrollColumn = 52
    ActiveWindow.ScrollColumn = 53
    ActiveWindow.ScrollColumn = 54
    Range("BI1").Select
    Selection.Copy
    Range("BJ1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BJ:BJ").Select
    Selection.FillDown
    Range("BJ1").Select
    Selection.Copy
    Range("BK1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BK:BK").Select
    Selection.FillDown
    Range("BK1").Select
    Selection.Copy
    Range("BL1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BL:BL").Select
    Selection.FillDown
    Range("BL1").Select
    Selection.Copy
    Range("BM1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BM:BM").Select
    Selection.FillDown
    Range("BM1").Select
    Selection.Copy
    Range("BN1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BN:BN").Select
    Selection.FillDown
    Range("BN1").Select
    Selection.Copy
    Range("BO1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BO:BO").Select
    Selection.FillDown
    Range("BO1").Select
    Selection.Copy
    Range("BP1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BP:BP").Select
    Selection.FillDown
    ActiveWindow.SmallScroll ToRight:=4
    Range("BP1").Select
    Selection.Copy
    Range("BQ1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BQ:BQ").Select
    Selection.FillDown
    Range("BQ1").Select
    Selection.Copy
    Range("BR1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("BR:BR").Select
    Selection.FillDown
    Range("BS1").Select
    ActiveWindow.ScrollColumn = 57
    ActiveWindow.ScrollColumn = 56
    ActiveWindow.ScrollColumn = 55
    ActiveWindow.ScrollColumn = 54
    ActiveWindow.ScrollColumn = 52
    ActiveWindow.ScrollColumn = 51
    ActiveWindow.ScrollColumn = 36
    ActiveWindow.ScrollColumn = 35
    ActiveWindow.ScrollColumn = 34
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("E:E").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 44
    ActiveWindow.ScrollColumn = 45
    ActiveWindow.ScrollColumn = 54
    ActiveWindow.SmallScroll Down:=-68
    ActiveWindow.SmallScroll ToRight:=4
    ActiveWindow.SmallScroll Down:=-34
    Range("BS1").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3],RC[-2],RC[-1])"
    Columns("BS:BS").Select
    Selection.FillDown
    Range("BT1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RIGHT(RC[-1],1)="","",LEFT(RC[-1],LEN(RC[-1])-1),RC[-1])"
    Columns("BT:BT").Select
    Selection.FillDown
    Columns("BT:BT").Select
    Selection.Copy
    ActiveWindow.LargeScroll ToRight:=-3
    Columns("T:T").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("T1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "activities"
    Columns("E:E").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Range("A1").Select
End Sub

[excelledsoftware]

No problem, This procedure can be accomplished with about 8 lines of code. Could you post your workbook with the desired result so I can be sure I write it correctly for you. Otherwise I just need to know what you are trying to do with the data. What I can see now is the the data in column T gets copied to column AN. Once it is pasted in AN the data somehow spans to column BP which is the part I dont think is necessary but again I need to see the spreadsheet to be sure. Then column AN gets selected and a text to columns is done. Afterwards each column is processed with a formula and then filled down.

Now if I assume correctly you have data in column T that needs to be changed from 1,2,3,4,5 to 001,002,003,004,005. Now if this is the case again we can write code to do it but You could also just a write a substitute formula in column U and then double click to autofill down. This formula typed in T2 and then autofilled down would work.

="00"&SUBSTITUTE(T2,",",",00")

The 00 at the beginning is to account for the first number. If this doesnt work the way you were looking post your book with the data on 1 worksheet before your code was run and then on a 2nd worksheet the desired result. Once I have this I think I can have it written in about 15 minutes once I start.

Let me know

Thanks

[wxtoad]

Attached is file with before and after sheets in the workbook. The After sheet shows the step by step results over past Col AN

I do various manipulations of data in most of the columns and I'm concluding that I need a way to tell a computation when to stop, rather than let it go all the way to the bottom of the sheet.

So the question is: is that something I can include in a macro that I record step by step, or do I have to get into the VBA editor?

Thanks very much.

[excelledsoftware]

Ok kewl,

Thanks for posting this. So just to clarify do you want the After sheet to look exactly as your sample book, or do you just need column T updated? If you want it to look just like the after sheet it will take a little bit more time but it will get done.

[wxtoad]

Just getting Col T squared away would be very helpful.

Thanks!

[excelledsoftware]

Alright sounds good.

A concern that you had was to make sure that your formula would know when to stop. VBA is really good at this because you can tell it to do something many times and tell it exactly when to stop. Learning VBA has been one of the best things that I have learned so if you are interested in what is going on with the code let me know and I will be happy to explain it to you.

The code below will REPLACE the values in column T with the specified format. Remember to backup your workbook before running it since this will change the existing data in column T on the first sheet of your workbook.

Option Explicit

Sub FormatNumberString()
  'Looks through a list of numbers on the first worksheet and formats them
  'with leading zeroes.
  
  Dim CheckRow As Long, LastRow As Long, CheckString() As String
  Dim x As Integer, arr As Long, ArrayString As Variant
  Dim NewString As String, TempString As String
  Dim wb As Workbook, ws As Worksheet
  
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets(1)
    LastRow = ws.Range("T50000").End(xlUp).Row
    ReDim CheckString(0 To LastRow - 1)
    
    'Grab the values
    arr = 0
    For CheckRow = 2 To LastRow
      CheckString(arr) = ws.Range("T" & CheckRow).Value
      arr = arr + 1
    Next CheckRow
    
    'Insert values back in with new format
    arr = 0
    For CheckRow = 2 To LastRow
      If CheckString(arr) <> "" Then
        'Convert each number to have leading zeroes
        ArrayString = Split(CheckString(arr), ",")
        For x = 0 To UBound(ArrayString)
          Select Case Len(ArrayString(x))
            Case 1:
              TempString = "00" & ArrayString(x)
            Case 2:
              TempString = "0" & ArrayString(x)
            End Select
            NewString = CStr(NewString & TempString & ",")
          Next x
          'Remove last comma
          NewString = Mid(NewString, 1, Len(NewString) - 1)
        ws.Range("T" & CheckRow).NumberFormat = "@"
        ws.Range("T" & CheckRow).Value = NewString
        NewString = ""
      End If
      arr = arr + 1
    Next CheckRow

End Sub

Let me know how it works out.

PS I know I said 8 lines of code I was really far off on that becuase I forgot it had both single, and double digit numbers to format. Sorry about that.

Thanks

[wxtoad]

Thanks for your work on this. I copy/pasted it into a macro. I see it listed as a macro, but nothing happens when I click on "run".

[excelledsoftware]

If you see it listed as macro it must not be in the right spot because it should show up as FormatNumberString.

Complete these steps.
1. open your workbook (until you are comfortable editing in the VBA editor you should only have 1 workbook open)
2. Press Alt + F11 to open up the editor.
3. On the Menu click Insert>Module
4. In the new module that comes up, copy and paste the entire code from Option Explicit to End Sub
5. Close the VBA editor or run the code from the editor by pressing the play button while your text cursor is somewhere in the code. Again be sure your workbook is backed up before running because you cannot undo a macro.

Let me know if you have any questions.

Thanks

[excelledsoftware]

Sorry I re-read your post. Make sure that when you run this code that the worksheet is the first in the workbook. If this is an issue let me know the exact worksheet name and I will update the code to look for this. Also to be sure it is or is not doing anything I will add one more thing to the code that after you validate it is working you can remove.

Option Explicit

Sub FormatNumberString()
  'Looks through a list of numbers on the first worksheet and formats them
  'with leading zeroes.
  
  Dim CheckRow As Long, LastRow As Long, CheckString() As String
  Dim x As Integer, arr As Long, ArrayString As Variant
  Dim NewString As String, TempString As String
  Dim wb As Workbook, ws As Worksheet
  
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets(1)
    LastRow = ws.Range("T50000").End(xlUp).Row
    ReDim CheckString(0 To LastRow - 1)
    
    ws.Activate
    'Grab the values
    arr = 0
    For CheckRow = 2 To LastRow
      ws.Range("T" & CheckRow).Select 'REMOVE THIS LINE ONCE CODE WORKS
      CheckString(arr) = ws.Range("T" & CheckRow).Value
      arr = arr + 1
    Next CheckRow
    
    'Insert values back in with new format
    arr = 0
    For CheckRow = 2 To LastRow
      ws.Range("T" & CheckRow).Select 'REMOVE THIS LINE ONCE CODE WORKS
      If CheckString(arr) <> "" Then
        'Convert each number to have leading zeroes
        ArrayString = Split(CheckString(arr), ",")
        For x = 0 To UBound(ArrayString)
          Select Case Len(ArrayString(x))
            Case 1:
              TempString = "00" & ArrayString(x)
            Case 2:
              TempString = "0" & ArrayString(x)
            End Select
            NewString = CStr(NewString & TempString & ",")
          Next x
          'Remove last comma
          NewString = Mid(NewString, 1, Len(NewString) - 1)
        ws.Range("T" & CheckRow).NumberFormat = "@"
        ws.Range("T" & CheckRow).Value = NewString
        NewString = ""
      End If
      arr = arr + 1
    Next CheckRow

End Sub

Now you can press F8 to see the code in action. After you see it works remove the 2 lines that say REMOVE

[wxtoad]

Got it! It works fine, so I thank you very much.

That's only a tiny piece of what I need to do with my data, so it's becoming more and more obvious that I need to dive into learning VBA.

Thanks so much for all your help!

[excelledsoftware]

You are welcome. contact me anytime if you have any questions about VBA. When I was first learning it really helped to talk to people who already knew it.