#1
|
|||
|
|||
Macros are VERY slow to run
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 |
#2
|
|||
|
|||
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.
|
#3
|
|||
|
|||
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. Code:
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 |
#4
|
|||
|
|||
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. Code:
="00"&SUBSTITUTE(T2,",",",00") Let me know Thanks |
#5
|
|||
|
|||
Before and After Sample
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. |
#6
|
|||
|
|||
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. |
#7
|
|||
|
|||
Just getting Col T squared away would be very helpful.
Thanks! |
#8
|
|||
|
|||
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. Code:
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 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 |
#9
|
|||
|
|||
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".
|
#10
|
|||
|
|||
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 |
#11
|
|||
|
|||
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.
Code:
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 |
#12
|
|||
|
|||
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! |
#13
|
|||
|
|||
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.
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Outlook '07--snail slow | markg2 | Outlook | 0 | 07-09-2014 09:42 AM |
Outlook slow? | erik2282 | Outlook | 3 | 12-09-2011 03:15 PM |
Slow load? | markg2 | Word | 1 | 03-15-2011 07:10 AM |
Slow (delayed) keystrokes | Jim Ogren | Word | 0 | 07-23-2009 07:47 PM |
slow start | kevb | Office | 1 | 08-15-2008 12:13 PM |