| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help Shorten Execution Time of VBA program
Hi, I am a rather new programmer in VBA. I have written a program that
produces a receivables aging schedule based on customer terms. This is intended to replace the aging report given by our accounting software which doesn't account for different time periods when a given invoice may be "current." Anyway, the program takes 17 minutes to execute on my system, which is faster than the system that will use the program. Is there anyone who would be up to scouring the following code for ways to make it faster? I know I'm asking for a really big favor... but any tips/advice/help would be appreciated. Code follows: Sub Custom_AR_Aging() Application.ScreenUpdating = False Dim vStart As Variant Dim vEnd As Variant Dim vElapsedtime As Variant vStart = Time Dim lrow As Long Dim lrow2 As Long Dim lrow3 As Long lrow3 = 2 Dim llastrowCust As Long Dim llastrowBill As Long Dim vTerms As Variant Dim vCustN As Variant Dim wsCust As Worksheet Dim wsBill As Worksheet Dim wsAge As Worksheet Dim dADate As Date Dim cAgeCurrent As Currency Dim cAge030 As Currency Dim cAge3160 As Currency Dim cAge6190 As Currency Dim cAge91 As Currency Dim cBalance As Currency Dim vAge As Variant Dim vRecord As Variant Set wsCust = Workbooks("Custom Aging.xls").Worksheets("CustCode") Set wsBill = Workbooks("Custom Aging.xls").Worksheets("Billing") Set wsAge = Workbooks("Custom Aging.xls").Worksheets("Aging") llastrowCust = wsCust.Cells(wsCust.Rows.Count, 1).End(xlUp).Row llastrowBill = wsBill.Cells(wsBill.Rows.Count, 1).End(xlUp).Row dADate = InputBox("Enter the 'as of' date for the Aging Schedule.") wsAge.Activate Cells.Select Selection.Clear Selection.ClearFormats 'The following For...Next loop goes through each customer code in the 'CustCode table and accumulates the open invoices for that customer from the 'billing table... each "terms code" is translated to a integer representing the 'number of days an invoice is current under those terms. For lrow = 2 To llastrowCust vTerms = wsCust.Cells(lrow, "F").Value vCustN = wsCust.Cells(lrow, "B").Value If vTerms = "NET 10" Then vTerms = 10 ElseIf vTerms = "NET 15" Then vTerms = 15 ElseIf vTerms = "NET 30" Then vTerms = 30 ElseIf vTerms = "NET 30 (INT)" Then vTerms = 30 ElseIf vTerms = "SPECIAL" Then vTerms = 30 ElseIf vTerms = "2%10NET30" Then vTerms = 30 ElseIf vTerms = "2%10THPROX" Then vTerms = 30 ElseIf vTerms = "NET 45" Then vTerms = 45 ElseIf vTerms = "NET45" Then vTerms = 45 ElseIf vTerms = "NET 60" Then vTerms = 60 ElseIf vTerms = "NET60" Then vTerms = 60 ElseIf vTerms = "2%15NET60" Then vTerms = 60 ElseIf vTerms = "2% NET 60" Then vTerms = 60 ElseIf vTerms = "NET 90" Then vTerms = 90 ElseIf vTerms = "NET90" Then vTerms = 90 ElseIf vTerms = "PREPAID CC" Then vTerms = 0 ElseIf vTerms = "PREPAID CK" Then vTerms = 0 ElseIf vTerms = "" Then vTerms = 0 ElseIf vTerms = "PO CREDIT" Then vTerms = 0 ElseIf vTerms = "COD" Then vTerms = 0 ElseIf vTerms = "NET DUE" Then vTerms = 0 ElseIf vTerms = "CASH" Then vTerms = 0 ElseIf vTerms = "WASH" Then vTerms = 0 ElseIf vTerms = "WIRE" Then vTerms = 0 Else MsgBox ("The Terms for a Customer Not Found: " & vbCr & _ vbCr & "Customer: " & vCustN & vbCr & _ "Terms: " & vTerms) GoTo TheEnd End If 'Here is where individual invoices are matched 'to the customer, and their balances are assigned 'to an aging bracket. For lrow2 = 2 To llastrowBill Step 1 If wsBill.Cells(lrow2, "E").Value = wsCust.Cells(lrow, "A").Value Then If wsBill.Cells(lrow2, "G").Value dADate Then 'Invoice not within date range ElseIf wsBill.Cells(lrow2, "G").Value <= dADate Then 'Invoice is within date range If wsBill.Cells(lrow2, "D").Value = "U" Then cBalance = wsBill.Cells(lrow2, "I").Value - wsBill.Cells(lrow2, "J").Value vAge = dADate - wsBill.Cells(lrow2, "G").Value If vAge <= vTerms Then cAgeCurrent = cAgeCurrent + cBalance ElseIf vAge <= vTerms + 30 Then cAge030 = cAge030 + cBalance ElseIf vAge <= vTerms + 60 Then cAge3160 = cAge3160 + cBalance ElseIf vAge <= vTerms + 90 Then cAge6190 = cAge6190 + cBalance ElseIf vAge vTerms + 90 Then cAge91 = cAge91 + cBalance End If ElseIf wsBill.Cells(lrow2, "D").Value = "P" Then If wsBill.Cells(lrow2, "H").Value dADate Then 'Invoice was paid after date specified cBalance = wsBill.Cells(lrow2, "I").Value - wsBill.Cells(lrow2, "J").Value vAge = dADate - wsBill.Cells(lrow2, "G").Value If vAge <= vTerms Then cAgeCurrent = cAgeCurrent + cBalance ElseIf vAge <= vTerms + 30 Then cAge030 = cAge030 + cBalance ElseIf vAge <= vTerms + 60 Then cAge3160 = cAge3160 + cBalance ElseIf vAge <= vTerms + 90 Then cAge6190 = cAge6190 + cBalance ElseIf vAge vTerms + 90 Then cAge91 = cAge91 + cBalance End If ElseIf wsBill.Cells(lrow2, "H").Value <= dADate Then Else MsgBox ("Error #1 during invoice evaluation.") GoTo TheEnd End If Else MsgBox ("Error #2 during invoice evaluation.") GoTo TheEnd End If End If End If Next lrow2 'Fill in Aging Schedule for the current customer vRecord = 0 vRecord = cAgeCurrent + cAge030 + cAge3160 + cAge6190 + cAge91 If vRecord < 0 Then lrow3 = lrow3 + 1 wsAge.Cells(lrow3, "A").Value = wsCust.Cells(lrow, "A").Value wsAge.Cells(lrow3, "B").Value = wsCust.Cells(lrow, "B").Value wsAge.Cells(lrow3, "C").Value = wsCust.Cells(lrow, "AC").Value wsAge.Cells(lrow3, "D").Value = cAgeCurrent wsAge.Cells(lrow3, "E").Value = cAge030 wsAge.Cells(lrow3, "F").Value = cAge3160 wsAge.Cells(lrow3, "G").Value = cAge6190 wsAge.Cells(lrow3, "H").Value = cAge91 wsAge.Cells(lrow3, "I").Value = cAgeCurrent + cAge030 + cAge3160 + cAge6190 + cAge91 End If cAgeCurrent = 0 cAge030 = 0 cAge3160 = 0 cAge6190 = 0 cAge91 = 0 Next lrow 'Format the aging report wsAge.Activate Range("D2").Select ActiveCell.FormulaR1C1 = "Current" Range("E2").Select ActiveCell.FormulaR1C1 = "0 to 30" Range("F2").Select ActiveCell.FormulaR1C1 = "31 to 60" Range("G2").Select ActiveCell.FormulaR1C1 = "61 to 90" Range("H2").Select ActiveCell.FormulaR1C1 = "90 +" Range("I2").Select Selection.Style = "Comma" ActiveCell.FormulaR1C1 = "Total" With ActiveCell.Characters(Start:=1, Length:=5).Font .Name = "MS Sans Serif" .FontStyle = "Regular" .Size = 10 End With Range("D1:I1").Select Range("I1").Activate With Selection .HorizontalAlignment = xlCenter End With Selection.Merge ActiveCell.FormulaR1C1 = "Aging" Range("D1:I1").Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Range("A2:B2").Select Selection.Merge With Selection .HorizontalAlignment = xlLeft .MergeCells = True End With ActiveCell.FormulaR1C1 = "Customer" Range("D2:I2").Select With Selection .HorizontalAlignment = xlCenter End With TheEnd: Application.ScreenUpdating = True vEnd = Time vElapsedtime = (vEnd - vStart) * 24 * 60 * 60 MsgBox ("Elapsed time: " & vElapsedtime & " sec.") End Sub |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help Shorten Execution Time of VBA program
I'm sorry the indentation on the code did not "stick." Please let me know if
I can post it some other way to make it more readable. |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help Shorten Execution Time of VBA program
Hi Jeff
Avoid all select statements and try to off calculaton while running the macro: Sub Custom_AR_Aging() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim vStart As Variant Dim vEnd As Variant Dim vElapsedtime As Variant vStart = Time Dim lrow As Long Dim lrow2 As Long Dim lrow3 As Long lrow3 = 2 Dim llastrowCust As Long Dim llastrowBill As Long Dim vTerms As Variant Dim vCustN As Variant Dim wsCust As Worksheet Dim wsBill As Worksheet Dim wsAge As Worksheet Dim dADate As Date Dim cAgeCurrent As Currency Dim cAge030 As Currency Dim cAge3160 As Currency Dim cAge6190 As Currency Dim cAge91 As Currency Dim cBalance As Currency Dim vAge As Variant Dim vRecord As Variant Set wsCust = Workbooks("Custom Aging.xls").Worksheets("CustCode") Set wsBill = Workbooks("Custom Aging.xls").Worksheets("Billing") Set wsAge = Workbooks("Custom Aging.xls").Worksheets("Aging") llastrowCust = wsCust.Cells(wsCust.Rows.Count, 1).End(xlUp).Row llastrowBill = wsBill.Cells(wsBill.Rows.Count, 1).End(xlUp).Row dADate = InputBox("Enter the 'as of' date for the Aging Schedule.") wsAge.Activate Cells.Clear Cells.ClearFormats 'The following For...Next loop goes through each customer code in the 'CustCode table and accumulates the open invoices for that customer from the 'billing table... each "terms code" is translated to a integer representing the 'number of days an invoice is current under those terms. For lrow = 2 To llastrowCust vTerms = wsCust.Cells(lrow, "F").Value vCustN = wsCust.Cells(lrow, "B").Value If vTerms = "NET 10" Then vTerms = 10 ElseIf vTerms = "NET 15" Then vTerms = 15 ElseIf vTerms = "NET 30" Then vTerms = 30 ElseIf vTerms = "NET 30 (INT)" Then vTerms = 30 ElseIf vTerms = "SPECIAL" Then vTerms = 30 ElseIf vTerms = "2%10NET30" Then vTerms = 30 ElseIf vTerms = "2%10THPROX" Then vTerms = 30 ElseIf vTerms = "NET 45" Then vTerms = 45 ElseIf vTerms = "NET45" Then vTerms = 45 ElseIf vTerms = "NET 60" Then vTerms = 60 ElseIf vTerms = "NET60" Then vTerms = 60 ElseIf vTerms = "2%15NET60" Then vTerms = 60 ElseIf vTerms = "2% NET 60" Then vTerms = 60 ElseIf vTerms = "NET 90" Then vTerms = 90 ElseIf vTerms = "NET90" Then vTerms = 90 ElseIf vTerms = "PREPAID CC" Then vTerms = 0 ElseIf vTerms = "PREPAID CK" Then vTerms = 0 ElseIf vTerms = "" Then vTerms = 0 ElseIf vTerms = "PO CREDIT" Then vTerms = 0 ElseIf vTerms = "COD" Then vTerms = 0 ElseIf vTerms = "NET DUE" Then vTerms = 0 ElseIf vTerms = "CASH" Then vTerms = 0 ElseIf vTerms = "WASH" Then vTerms = 0 ElseIf vTerms = "WIRE" Then vTerms = 0 Else MsgBox ("The Terms for a Customer Not Found: " & vbCr & _ vbCr & "Customer: " & vCustN & vbCr & _ "Terms: " & vTerms) GoTo TheEnd End If 'Here is where individual invoices are matched 'to the customer, and their balances are assigned 'to an aging bracket. For lrow2 = 2 To llastrowBill Step 1 If wsBill.Cells(lrow2, "E").Value = wsCust.Cells(lrow, "A").Value Then If wsBill.Cells(lrow2, "G").Value dADate Then 'Invoice not within date range ElseIf wsBill.Cells(lrow2, "G").Value <= dADate Then 'Invoice is within date range If wsBill.Cells(lrow2, "D").Value = "U" Then cBalance = wsBill.Cells(lrow2, "I").Value - wsBill.Cells(lrow2, "J").Value vAge = dADate - wsBill.Cells(lrow2, "G").Value If vAge <= vTerms Then cAgeCurrent = cAgeCurrent + cBalance ElseIf vAge <= vTerms + 30 Then cAge030 = cAge030 + cBalance ElseIf vAge <= vTerms + 60 Then cAge3160 = cAge3160 + cBalance ElseIf vAge <= vTerms + 90 Then cAge6190 = cAge6190 + cBalance ElseIf vAge vTerms + 90 Then cAge91 = cAge91 + cBalance End If ElseIf wsBill.Cells(lrow2, "D").Value = "P" Then If wsBill.Cells(lrow2, "H").Value dADate Then 'Invoice was paid after date specified cBalance = wsBill.Cells(lrow2, "I").Value - wsBill.Cells(lrow2, "J").Value vAge = dADate - wsBill.Cells(lrow2, "G").Value If vAge <= vTerms Then cAgeCurrent = cAgeCurrent + cBalance ElseIf vAge <= vTerms + 30 Then cAge030 = cAge030 + cBalance ElseIf vAge <= vTerms + 60 Then cAge3160 = cAge3160 + cBalance ElseIf vAge <= vTerms + 90 Then cAge6190 = cAge6190 + cBalance ElseIf vAge vTerms + 90 Then cAge91 = cAge91 + cBalance End If ElseIf wsBill.Cells(lrow2, "H").Value <= dADate Then Else MsgBox ("Error #1 during invoice evaluation.") GoTo TheEnd End If Else MsgBox ("Error #2 during invoice evaluation.") GoTo TheEnd End If End If End If Next lrow2 'Fill in Aging Schedule for the current customer vRecord = 0 vRecord = cAgeCurrent + cAge030 + cAge3160 + cAge6190 + cAge91 If vRecord < 0 Then lrow3 = lrow3 + 1 wsAge.Cells(lrow3, "A").Value = wsCust.Cells(lrow, "A").Value wsAge.Cells(lrow3, "B").Value = wsCust.Cells(lrow, "B").Value wsAge.Cells(lrow3, "C").Value = wsCust.Cells(lrow, "AC").Value wsAge.Cells(lrow3, "D").Value = cAgeCurrent wsAge.Cells(lrow3, "E").Value = cAge030 wsAge.Cells(lrow3, "F").Value = cAge3160 wsAge.Cells(lrow3, "G").Value = cAge6190 wsAge.Cells(lrow3, "H").Value = cAge91 wsAge.Cells(lrow3, "I").Value = vRecord 'cAgeCurrent + cAge030 + cAge3160 + cAge6190 + cAge91 End If cAgeCurrent = 0 cAge030 = 0 cAge3160 = 0 cAge6190 = 0 cAge91 = 0 Next lrow 'Format the aging report wsAge.Activate Range("D2") = "Current" Range("E2") = "0 to 30" Range("F2") = "31 to 60" Range("G2") = "61 to 90" Range("H2") = "90 +" With Range("I2") .Style = "Comma" .FormulaR1C1 = "Total" With .Characters(Start:=1, Length:=5).Font .Name = "MS Sans Serif" .FontStyle = "Regular" .Size = 10 End With End With With Range("D1:I1") .HorizontalAlignment = xlCenter .Merge .FormulaR1C1 = "Aging" With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With End With With Range("A2:B2") .Merge .HorizontalAlignment = xlLeft .MergeCells = True .FormulaR1C1 = "Customer" End With Range("D2:I2").HorizontalAlignment = xlCenter TheEnd: With Application .ScreenUpdating = True .Calculation = xlAutomatic End With vEnd = Time vElapsedtime = (vEnd - vStart) * 24 * 60 * 60 MsgBox ("Elapsed time: " & vElapsedtime & " sec.") End Sub Hopes this helps. --- Per "Jeff" skrev i meddelelsen ... Hi, I am a rather new programmer in VBA. I have written a program that produces a receivables aging schedule based on customer terms. This is intended to replace the aging report given by our accounting software which doesn't account for different time periods when a given invoice may be "current." Anyway, the program takes 17 minutes to execute on my system, which is faster than the system that will use the program. Is there anyone who would be up to scouring the following code for ways to make it faster? I know I'm asking for a really big favor... but any tips/advice/help would be appreciated. Code follows: Sub Custom_AR_Aging() Application.ScreenUpdating = False Dim vStart As Variant Dim vEnd As Variant Dim vElapsedtime As Variant vStart = Time Dim lrow As Long Dim lrow2 As Long Dim lrow3 As Long lrow3 = 2 Dim llastrowCust As Long Dim llastrowBill As Long Dim vTerms As Variant Dim vCustN As Variant Dim wsCust As Worksheet Dim wsBill As Worksheet Dim wsAge As Worksheet Dim dADate As Date Dim cAgeCurrent As Currency Dim cAge030 As Currency Dim cAge3160 As Currency Dim cAge6190 As Currency Dim cAge91 As Currency Dim cBalance As Currency Dim vAge As Variant Dim vRecord As Variant Set wsCust = Workbooks("Custom Aging.xls").Worksheets("CustCode") Set wsBill = Workbooks("Custom Aging.xls").Worksheets("Billing") Set wsAge = Workbooks("Custom Aging.xls").Worksheets("Aging") llastrowCust = wsCust.Cells(wsCust.Rows.Count, 1).End(xlUp).Row llastrowBill = wsBill.Cells(wsBill.Rows.Count, 1).End(xlUp).Row dADate = InputBox("Enter the 'as of' date for the Aging Schedule.") wsAge.Activate Cells.Select Selection.Clear Selection.ClearFormats 'The following For...Next loop goes through each customer code in the 'CustCode table and accumulates the open invoices for that customer from the 'billing table... each "terms code" is translated to a integer representing the 'number of days an invoice is current under those terms. For lrow = 2 To llastrowCust vTerms = wsCust.Cells(lrow, "F").Value vCustN = wsCust.Cells(lrow, "B").Value If vTerms = "NET 10" Then vTerms = 10 ElseIf vTerms = "NET 15" Then vTerms = 15 ElseIf vTerms = "NET 30" Then vTerms = 30 ElseIf vTerms = "NET 30 (INT)" Then vTerms = 30 ElseIf vTerms = "SPECIAL" Then vTerms = 30 ElseIf vTerms = "2%10NET30" Then vTerms = 30 ElseIf vTerms = "2%10THPROX" Then vTerms = 30 ElseIf vTerms = "NET 45" Then vTerms = 45 ElseIf vTerms = "NET45" Then vTerms = 45 ElseIf vTerms = "NET 60" Then vTerms = 60 ElseIf vTerms = "NET60" Then vTerms = 60 ElseIf vTerms = "2%15NET60" Then vTerms = 60 ElseIf vTerms = "2% NET 60" Then vTerms = 60 ElseIf vTerms = "NET 90" Then vTerms = 90 ElseIf vTerms = "NET90" Then vTerms = 90 ElseIf vTerms = "PREPAID CC" Then vTerms = 0 ElseIf vTerms = "PREPAID CK" Then vTerms = 0 ElseIf vTerms = "" Then vTerms = 0 ElseIf vTerms = "PO CREDIT" Then vTerms = 0 ElseIf vTerms = "COD" Then vTerms = 0 ElseIf vTerms = "NET DUE" Then vTerms = 0 ElseIf vTerms = "CASH" Then vTerms = 0 ElseIf vTerms = "WASH" Then vTerms = 0 ElseIf vTerms = "WIRE" Then vTerms = 0 Else MsgBox ("The Terms for a Customer Not Found: " & vbCr & _ vbCr & "Customer: " & vCustN & vbCr & _ "Terms: " & vTerms) GoTo TheEnd End If 'Here is where individual invoices are matched 'to the customer, and their balances are assigned 'to an aging bracket. For lrow2 = 2 To llastrowBill Step 1 If wsBill.Cells(lrow2, "E").Value = wsCust.Cells(lrow, "A").Value Then If wsBill.Cells(lrow2, "G").Value dADate Then 'Invoice not within date range ElseIf wsBill.Cells(lrow2, "G").Value <= dADate Then 'Invoice is within date range If wsBill.Cells(lrow2, "D").Value = "U" Then cBalance = wsBill.Cells(lrow2, "I").Value - wsBill.Cells(lrow2, "J").Value vAge = dADate - wsBill.Cells(lrow2, "G").Value If vAge <= vTerms Then cAgeCurrent = cAgeCurrent + cBalance ElseIf vAge <= vTerms + 30 Then cAge030 = cAge030 + cBalance ElseIf vAge <= vTerms + 60 Then cAge3160 = cAge3160 + cBalance ElseIf vAge <= vTerms + 90 Then cAge6190 = cAge6190 + cBalance ElseIf vAge vTerms + 90 Then cAge91 = cAge91 + cBalance End If ElseIf wsBill.Cells(lrow2, "D").Value = "P" Then If wsBill.Cells(lrow2, "H").Value dADate Then 'Invoice was paid after date specified cBalance = wsBill.Cells(lrow2, "I").Value - wsBill.Cells(lrow2, "J").Value vAge = dADate - wsBill.Cells(lrow2, "G").Value If vAge <= vTerms Then cAgeCurrent = cAgeCurrent + cBalance ElseIf vAge <= vTerms + 30 Then cAge030 = cAge030 + cBalance ElseIf vAge <= vTerms + 60 Then cAge3160 = cAge3160 + cBalance ElseIf vAge <= vTerms + 90 Then cAge6190 = cAge6190 + cBalance ElseIf vAge vTerms + 90 Then cAge91 = cAge91 + cBalance End If ElseIf wsBill.Cells(lrow2, "H").Value <= dADate Then Else MsgBox ("Error #1 during invoice evaluation.") GoTo TheEnd End If Else MsgBox ("Error #2 during invoice evaluation.") GoTo TheEnd End If End If End If Next lrow2 'Fill in Aging Schedule for the current customer vRecord = 0 vRecord = cAgeCurrent + cAge030 + cAge3160 + cAge6190 + cAge91 If vRecord < 0 Then lrow3 = lrow3 + 1 wsAge.Cells(lrow3, "A").Value = wsCust.Cells(lrow, "A").Value wsAge.Cells(lrow3, "B").Value = wsCust.Cells(lrow, "B").Value wsAge.Cells(lrow3, "C").Value = wsCust.Cells(lrow, "AC").Value wsAge.Cells(lrow3, "D").Value = cAgeCurrent wsAge.Cells(lrow3, "E").Value = cAge030 wsAge.Cells(lrow3, "F").Value = cAge3160 wsAge.Cells(lrow3, "G").Value = cAge6190 wsAge.Cells(lrow3, "H").Value = cAge91 wsAge.Cells(lrow3, "I").Value = cAgeCurrent + cAge030 + cAge3160 + cAge6190 + cAge91 End If cAgeCurrent = 0 cAge030 = 0 cAge3160 = 0 cAge6190 = 0 cAge91 = 0 Next lrow 'Format the aging report wsAge.Activate Range("D2").Select ActiveCell.FormulaR1C1 = "Current" Range("E2").Select ActiveCell.FormulaR1C1 = "0 to 30" Range("F2").Select ActiveCell.FormulaR1C1 = "31 to 60" Range("G2").Select ActiveCell.FormulaR1C1 = "61 to 90" Range("H2").Select ActiveCell.FormulaR1C1 = "90 +" Range("I2").Select Selection.Style = "Comma" ActiveCell.FormulaR1C1 = "Total" With ActiveCell.Characters(Start:=1, Length:=5).Font .Name = "MS Sans Serif" .FontStyle = "Regular" .Size = 10 End With Range("D1:I1").Select Range("I1").Activate With Selection .HorizontalAlignment = xlCenter End With Selection.Merge ActiveCell.FormulaR1C1 = "Aging" Range("D1:I1").Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Range("A2:B2").Select Selection.Merge With Selection .HorizontalAlignment = xlLeft .MergeCells = True End With ActiveCell.FormulaR1C1 = "Customer" Range("D2:I2").Select With Selection .HorizontalAlignment = xlCenter End With TheEnd: Application.ScreenUpdating = True vEnd = Time vElapsedtime = (vEnd - vStart) * 24 * 60 * 60 MsgBox ("Elapsed time: " & vElapsedtime & " sec.") End Sub |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Program execution slows down as iterations increase | Excel Programming | |||
| Program execution slows down in as iterations increase | Excel Programming | |||
| Execution ends without error message in middle of program | Excel Programming | |||
| Program execution prob | Excel Programming | |||
| MsgBox execution sends program into design mode | Excel Programming | |||
Linear Mode
