Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
faster macro
Hi,
I am using this macro to run numbers through a calculator in another sheet. It takes numbers from the same columns except for one column, row to row and deposits the results in another column. Basically it is the same sub routine duplicated to shift to the variable column 10 times. This macro takes 4 hours to run 10 columns of new data through 5,000 - 10,000 rows of data depending on the size of the sheet. Is there a way to write this macro so it finishes faster? If you need more information, let me know. Regards, Tim Option Explicit Sub forecastupto10() Dim callsWks As Worksheet Dim FRCSTWks As Worksheet Dim rCtr As Long 'row counter Dim FirstRow As Long Dim LastRow As Long Dim cCtr As Long 'col counter Dim beforeCol As Variant 'on calls Dim beforeAddress As Variant 'on FRCST Dim afterCol As Variant 'on calls Dim afterAddress As Variant 'on FRCST Set callsWks = Worksheets("calls") Set FRCSTWks = Worksheets("FRCST") beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "bz", "aq", "ap") '1 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ca") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cb", "aq", "ap") '2 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cc") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cd", "aq", "ap") '3 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ce") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cf", "aq", "ap") '4 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cg") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "ch", "aq", "ap") '5 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ci") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cj", "aq", "ap") '6 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ck") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cl", "aq", "ap") '7 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cm") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cn", "aq", "ap") '8 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("co") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cp", "aq", "ap") '9 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cq") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, ' beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cr", "aq", "ap") '10 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cs") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
faster macro
Tim,
I'll get to work on this. Mail you when I'm done. The main speed increase will probably come from disabling recalculation, screenupdating etc.. I'll also rewrite it bit to put the loops in a loop instead of repeating same code 6 times. keepITcool < email : keepitcool chello nl (with @ and .) < homepage: http://members.chello.nl/keepitcool "_______Tim_______" wrote: Hi, I am using this macro to run numbers through a calculator in another sheet. It takes numbers from the same columns except for one column, row to row and deposits the results in another column. Basically it is the same sub routine duplicated to shift to the variable column 10 times. This macro takes 4 hours to run 10 columns of new data through 5,000 - 10,000 rows of data depending on the size of the sheet. Is there a way to write this macro so it finishes faster? If you need more information, let me know. Regards, Tim |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
faster macro
At the top of the procedure
Application.Calculation = xlManual at the bottom of the procedure Application.Calculation = xlAutomatic running the code on a sheet doing almost no calculation to about 2.5 minutes on my machine - setting calculation to manual reduced that to a little less than 2 minutes. So trying to minimize the amount of calculation should be your biggest savings. -- Regards, Tom Ogilvy _______Tim_______ wrote in message ... Hi, I am using this macro to run numbers through a calculator in another sheet. It takes numbers from the same columns except for one column, row to row and deposits the results in another column. Basically it is the same sub routine duplicated to shift to the variable column 10 times. This macro takes 4 hours to run 10 columns of new data through 5,000 - 10,000 rows of data depending on the size of the sheet. Is there a way to write this macro so it finishes faster? If you need more information, let me know. Regards, Tim Option Explicit Sub forecastupto10() Dim callsWks As Worksheet Dim FRCSTWks As Worksheet Dim rCtr As Long 'row counter Dim FirstRow As Long Dim LastRow As Long Dim cCtr As Long 'col counter Dim beforeCol As Variant 'on calls Dim beforeAddress As Variant 'on FRCST Dim afterCol As Variant 'on calls Dim afterAddress As Variant 'on FRCST Set callsWks = Worksheets("calls") Set FRCSTWks = Worksheets("FRCST") beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "bz", "aq", "ap") '1 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ca") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cb", "aq", "ap") '2 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cc") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cd", "aq", "ap") '3 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ce") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cf", "aq", "ap") '4 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cg") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "ch", "aq", "ap") '5 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ci") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cj", "aq", "ap") '6 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ck") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cl", "aq", "ap") '7 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cm") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cn", "aq", "ap") '8 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("co") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cp", "aq", "ap") '9 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cq") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, ' beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cr", "aq", "ap") '10 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cs") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol(cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound(afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
faster macro
Tom
It's probably more in the sequencing of the loops. PLUS he's copying individual cells rather than ranges. AND he's not disabling events/calculation nor screenupdating. like they say... it's rather confusing :) at present he's looping 10 blocks of 6000 scenarios of 10 cells whereas his intention may be: 10 blocks of 10 scenarios of 6000 cells. i've sent OP a mail. waiting for reaction. keepITcool < email : keepitcool chello nl (with @ and .) < homepage: http://members.chello.nl/keepitcool "Tom Ogilvy" wrote: At the top of the procedure Application.Calculation = xlManual at the bottom of the procedure Application.Calculation = xlAutomatic running the code on a sheet doing almost no calculation to about 2.5 minutes on my machine - setting calculation to manual reduced that to a little less than 2 minutes. So trying to minimize the amount of calculation should be your biggest savings. -- Regards, Tom Ogilvy _______Tim_______ wrote in message ... Hi, |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
faster macro
This is the mail I sent to OP just now..
Tim Been fiddling with your sheet. Darn.. it's hard to read somebody elses code if you haven't got the data So what I did was set up some dummy sheets to see what your macro was doing exactly. My advice is following: In your forecast sheet use cell C4 as the base of an offset formula the macro will just change this 1 cell and formulas will do the rest! Then copy a few formulas in c5:c13 to pick up the data from "calls" C5=OFFSET(calls!E$1,C$4,0) C6=OFFSET(calls!J$1,C$4,0) C7=OFFSET(calls!Q$1,C$4,0) C8=OFFSET(calls!K$1,C$4,0) C9=OFFSET(calls!AA$1,C$4,0) C10=OFFSET(calls!AI$1,C$4,0) C11=OFFSET(calls!BZ$1,C$4,0) C12=OFFSET(calls!AQ$1,C$4,0) C13=OFFSET(calls!AP$1,C$4,0) now your macro gets a bit simpler: Sub NewFrcst() 'PLEASE NOTE THAT AS FAR AS I CAN SEE 'LOOPING THE LNGCOL changes NOTHING!!!!!!!!! Dim lngCol As Long Dim lngRow As Long Application.ScreenUpdating = False For lngCol = 0 To 18 Step 2 With [calls!CC:CC].Offset(0, lngCol) For lngRow = 12 To [calls!E65536].End(xlUp).Row [frcst!c4] = lngRow .Cells(lngRow) = [frcst!c20] Next End With Next Application.ScreenUpdating = True End Sub This should improve speed, as only 1 cell gets updated, so only 1 change event will lead to recalc. keepITcool < email : keepitcool chello nl (with @ and .) < homepage: http://members.chello.nl/keepitcool "Tom Ogilvy" wrote: I looked at his code a bit and he isn't copying any blocks. ("e", "j", "q", "k", "aa", "ai", "bz", "aq", "ap") '1 ("e", "j", "q", "k", "aa", "ai", "cb", "aq", "ap") '2 ("e", "j", "q", "k", "aa", "ai", "cd", "aq", "ap") '3 ("e", "j", "q", "k", "aa", "ai", "cf", "aq", "ap") '4 ("e", "j", "q", "k", "aa", "ai", "ch", "aq", "ap") '5 ("e", "j", "q", "k", "aa", "ai", "cj", "aq", "ap") '6 ("e", "j", "q", "k", "aa", "ai", "cl", "aq", "ap") '7 ("e", "j", "q", "k", "aa", "ai", "cn", "aq", "ap") '8 ("e", "j", "q", "k", "aa", "ai", "cp", "aq", "ap") '9 ("e", "j", "q", "k", "aa", "ai", "cr", "aq", "ap") '10 It looks like you could eliminate the copying of the values from the 8 non changing columns and only copy them once per row. However, as I stated, running the code with no real work being done, only involves about 2 minutes - so rearranging the code can reduce that, but the other 3 hours and 58 minutes is probably the results of calculation. Besides turning off calculation, any changes in procedures should focus on reducing the number of calculations - his calculation occurs once per row and returns one value per row - don't see a big harvest in rearranging the code. You might have better ideas, of course. It's probably more in the sequencing of the loops. doubt it PLUS he's copying individual cells rather than ranges. he needs to AND he's not disabling events/calculation nor screenupdating. suggested disabling calculation - didn't consider he might have events, his code would have minimal impact from screenupdating from what I can see, but doesn't hurt if he has the forecast sheet visible. I didn't run his actual code. I copied one complete set of loops and put in an outerloop to do that 10 times. -- Regards, Tom Ogilvy keepitcool wrote in message ... Tom It's probably more in the sequencing of the loops. PLUS he's copying individual cells rather than ranges. AND he's not disabling events/calculation nor screenupdating. like they say... it's rather confusing :) at present he's looping 10 blocks of 6000 scenarios of 10 cells whereas his intention may be: 10 blocks of 10 scenarios of 6000 cells. i've sent OP a mail. waiting for reaction. keepITcool < email : keepitcool chello nl (with @ and .) < homepage: http://members.chello.nl/keepitcool "Tom Ogilvy" wrote: At the top of the procedure Application.Calculation = xlManual at the bottom of the procedure Application.Calculation = xlAutomatic running the code on a sheet doing almost no calculation to about 2.5 minutes on my machine - setting calculation to manual reduced that to a little less than 2 minutes. So trying to minimize the amount of calculation should be your biggest savings. -- Regards, Tom Ogilvy _______Tim_______ wrote in message ... Hi, |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
faster macro
In a blank workbook I ran my version of his code (1 section looped 10 times
with calculation set to manual) and your code (my version of his code is not a suggested improvement - just saying the 4 hours is not necessarily produced by sloppy code - yours is certainly an improvement in volume and clarity). Time in seconds 28.55469 my version of his code (with screen updating on) 54.8125 your code (with screen updating on) 23.78125 my version of his code (with scren updating off) 11.91406 your code (as written with screenupdating off) Your code misses the fact that the 7th column changes on each of the loops through lngCol, but fixing that wouldn't be a big time taxer. Appears turning screenupdating off is more critical than I suggested - affected by formula updates I expect. So the question is if your tighter code with reduced calculation requirement would be significantly more efficient than just setting calculation to manual in the existing code. -- Regards, Tom Ogilvy keepitcool wrote in message ... This is the mail I sent to OP just now.. Tim Been fiddling with your sheet. Darn.. it's hard to read somebody elses code if you haven't got the data So what I did was set up some dummy sheets to see what your macro was doing exactly. My advice is following: In your forecast sheet use cell C4 as the base of an offset formula the macro will just change this 1 cell and formulas will do the rest! Then copy a few formulas in c5:c13 to pick up the data from "calls" C5=OFFSET(calls!E$1,C$4,0) C6=OFFSET(calls!J$1,C$4,0) C7=OFFSET(calls!Q$1,C$4,0) C8=OFFSET(calls!K$1,C$4,0) C9=OFFSET(calls!AA$1,C$4,0) C10=OFFSET(calls!AI$1,C$4,0) C11=OFFSET(calls!BZ$1,C$4,0) C12=OFFSET(calls!AQ$1,C$4,0) C13=OFFSET(calls!AP$1,C$4,0) now your macro gets a bit simpler: Sub NewFrcst() 'PLEASE NOTE THAT AS FAR AS I CAN SEE 'LOOPING THE LNGCOL changes NOTHING!!!!!!!!! Dim lngCol As Long Dim lngRow As Long Application.ScreenUpdating = False For lngCol = 0 To 18 Step 2 With [calls!CC:CC].Offset(0, lngCol) For lngRow = 12 To [calls!E65536].End(xlUp).Row [frcst!c4] = lngRow .Cells(lngRow) = [frcst!c20] Next End With Next Application.ScreenUpdating = True End Sub This should improve speed, as only 1 cell gets updated, so only 1 change event will lead to recalc. keepITcool < email : keepitcool chello nl (with @ and .) < homepage: http://members.chello.nl/keepitcool "Tom Ogilvy" wrote: I looked at his code a bit and he isn't copying any blocks. ("e", "j", "q", "k", "aa", "ai", "bz", "aq", "ap") '1 ("e", "j", "q", "k", "aa", "ai", "cb", "aq", "ap") '2 ("e", "j", "q", "k", "aa", "ai", "cd", "aq", "ap") '3 ("e", "j", "q", "k", "aa", "ai", "cf", "aq", "ap") '4 ("e", "j", "q", "k", "aa", "ai", "ch", "aq", "ap") '5 ("e", "j", "q", "k", "aa", "ai", "cj", "aq", "ap") '6 ("e", "j", "q", "k", "aa", "ai", "cl", "aq", "ap") '7 ("e", "j", "q", "k", "aa", "ai", "cn", "aq", "ap") '8 ("e", "j", "q", "k", "aa", "ai", "cp", "aq", "ap") '9 ("e", "j", "q", "k", "aa", "ai", "cr", "aq", "ap") '10 It looks like you could eliminate the copying of the values from the 8 non changing columns and only copy them once per row. However, as I stated, running the code with no real work being done, only involves about 2 minutes - so rearranging the code can reduce that, but the other 3 hours and 58 minutes is probably the results of calculation. Besides turning off calculation, any changes in procedures should focus on reducing the number of calculations - his calculation occurs once per row and returns one value per row - don't see a big harvest in rearranging the code. You might have better ideas, of course. It's probably more in the sequencing of the loops. doubt it PLUS he's copying individual cells rather than ranges. he needs to AND he's not disabling events/calculation nor screenupdating. suggested disabling calculation - didn't consider he might have events, his code would have minimal impact from screenupdating from what I can see, but doesn't hurt if he has the forecast sheet visible. I didn't run his actual code. I copied one complete set of loops and put in an outerloop to do that 10 times. -- Regards, Tom Ogilvy keepitcool wrote in message ... Tom It's probably more in the sequencing of the loops. PLUS he's copying individual cells rather than ranges. AND he's not disabling events/calculation nor screenupdating. like they say... it's rather confusing :) at present he's looping 10 blocks of 6000 scenarios of 10 cells whereas his intention may be: 10 blocks of 10 scenarios of 6000 cells. i've sent OP a mail. waiting for reaction. keepITcool < email : keepitcool chello nl (with @ and .) < homepage: http://members.chello.nl/keepitcool "Tom Ogilvy" wrote: At the top of the procedure Application.Calculation = xlManual at the bottom of the procedure Application.Calculation = xlAutomatic running the code on a sheet doing almost no calculation to about 2.5 minutes on my machine - setting calculation to manual reduced that to a little less than 2 minutes. So trying to minimize the amount of calculation should be your biggest savings. -- Regards, Tom Ogilvy _______Tim_______ wrote in message ... Hi, |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
faster macro
Thank you all for great information. I added the code Tom
suggested and cut the run time in half! Some of the other suggestions are way above my head for now. I am sure this workbook can be optimized in many ways, but I just don't know enough to make that happen. keepITcool has requested a sample workbook, which I am putting together for him. If anyone else would like one let me know. I have a macro I use on another project that I think could be modified for this application. With this other macro I just tell it what file to get and the file is brought into an excel sheet and all the calculations are done! Even if using this other macro method were not faster, it would be nice to start it and walk away. I can also provide you with this sample macro and workbooks if you are interested. Again, thank you all for your help. Regards, Tim -----Original Message----- Hi, I am using this macro to run numbers through a calculator in another sheet. It takes numbers from the same columns except for one column, row to row and deposits the results in another column. Basically it is the same sub routine duplicated to shift to the variable column 10 times. This macro takes 4 hours to run 10 columns of new data through 5,000 - 10,000 rows of data depending on the size of the sheet. Is there a way to write this macro so it finishes faster? If you need more information, let me know. Regards, Tim Option Explicit Sub forecastupto10() Dim callsWks As Worksheet Dim FRCSTWks As Worksheet Dim rCtr As Long 'row counter Dim FirstRow As Long Dim LastRow As Long Dim cCtr As Long 'col counter Dim beforeCol As Variant 'on calls Dim beforeAddress As Variant 'on FRCST Dim afterCol As Variant 'on calls Dim afterAddress As Variant 'on FRCST Set callsWks = Worksheets("calls") Set FRCSTWks = Worksheets("FRCST") beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "bz", "aq", "ap") '1 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ca") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol (cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound (afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cb", "aq", "ap") '2 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cc") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol (cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound (afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cd", "aq", "ap") '3 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ce") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol (cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound (afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cf", "aq", "ap") '4 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cg") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol (cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound (afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "ch", "aq", "ap") '5 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ci") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol (cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound (afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cj", "aq", "ap") '6 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("ck") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol (cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound (afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cl", "aq", "ap") '7 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cm") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol (cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound (afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cn", "aq", "ap") '8 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("co") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol (cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound (afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cp", "aq", "ap") '9 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cq") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, ' beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol (cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound (afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With beforeCol = Array ("e", "j", "q", "k", "aa", "ai", "cr", "aq", "ap") '10 beforeAddress = Array ("C5", "C6", "C7", "C8", "C9", "C10", "C11", "c12", "C13") If UBound(beforeCol) < UBound(beforeAddress) Then MsgBox "Error in before layout!" Exit Sub End If afterCol = Array("cs") afterAddress = Array("C20") If UBound(afterCol) < UBound(afterAddress) Then MsgBox "Error in after layout!" Exit Sub End If With callsWks FirstRow = 12 '??? LastRow = 6763 'LastRow = .Cells(.Rows.Count, _ beforeCol(LBound (beforeCol))).End(xlUp).Row For rCtr = FirstRow To LastRow 'move 'em in For cCtr = LBound(beforeCol) To UBound (beforeCol) FRCSTWks.Range(beforeAddress(cCtr)).Value _ = .Cells(rCtr, beforeCol (cCtr)) Next cCtr Application.Calculate 'just to make sure 'head 'em out For cCtr = LBound(afterCol) To UBound (afterCol) .Cells(rCtr, afterCol(cCtr)).Value _ = FRCSTWks.Range(afterAddress (cCtr)).Value Next cCtr 'rawhide <bg Next rCtr End With End Sub . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How can my macro run faster ? | New Users to Excel | |||
How do I print faster? | Excel Discussion (Misc queries) | |||
WHY the same macro runs so slowly on a different but faster comput | Excel Discussion (Misc queries) | |||
can this be done faster? | Excel Discussion (Misc queries) | |||
Can faster CPU+larger/faster RAM significantly speed up recalulati | Excel Discussion (Misc queries) |