Clear Excel cache without exiting Excel?

[jdaywalt]

I have a macro that contains a loop that basically performs a series of copy & paste procedures. The number of rows can vary, up to a max of 1500. After each copy/paste, I clear the clipboard using Application.CutCopyMode = False. I have run multiple iterations of this macro with consistently the same issue ... the first time I run the macro, it takes about 1-1/2 minutes to process. The second time I run it (without saving the file or doing anything else), it processes in roughly the same amount of time. The third time I run it, the processing triples or quadruples, and each subsequent attempt after that increase time as well. The interesting thing is that if I completely exit Excel, then re-open Excel & re-open the file, it seems to "clear" the cache and the macro takes 1-1/2 minutes again. I have gone through this routine at least 5 times with the same end result. Is there ANY type of code that can be used to clear the Excel cache (not just the internal clipboard) that can remedy my problem? It is simply not practical to ask users to constantly save file, close Excel, reopen Excel, reopen file, run macro!!

FYI, I've posted my code below:

Sub Consolidate_records()

Sheets("EventMerge").Range("BS5").Value = Now()

Rows("27:" & CStr(Range("BR16").Value + 26)).Select
Selection.RowHeight = 9.75


Range("BS" & CStr(Range("BR16").Value + 26)).Select
Application.Calculation = xlManual
Do Until ActiveCell.Offset(0, -56).Value = "1st Event Row"
If ActiveCell.Offset(0, -56).Value = 0 Then
ActiveCell.Offset(0, 0).Range("A1:CA1").Copy
ActiveCell.Offset(-1, 0).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, SkipBlanks:=True
Application.CutCopyMode = False
Else
ActiveCell.Offset(-1, 0).Select
End If
Loop
'Then delete rows that are not the "1st event row"
If Range("N23").Value > 0 Then
Range("A27:DS50000").Select
ActiveWorkbook.Worksheets("EventMerge").Sort.SortFields.add Key:=Range( _
"O27:O50000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal

ActiveSheet.Range("$A$26:$DS$50000").AutoFilter Field:=15, Criteria1:="0"
Range("A27:A" & CStr(Range("BR16").Value + 26)).Select
Selection.ClearContents
Selection.EntireRow.Delete
Else
End If

If ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If

Application.Calculation = xlAutomatic

Sheets("EventMerge").Range("BS6").Value = Now()
Range("BV5").Value = Range("BS7").Value
End Sub

 

[sijpie]

You are using slow and resource eating copy paste. This is an ideal situation to just set the values of the two ranges equal (since you paste as values)

Oh, yes and use

...[/ code] tags around your code (use 'Go advanced' reply and click the button with a # on it)

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Consolidate_records()<br><br>    Sheets("EventMerge").Range("BS5").Value = Now()<br>    <br>    Rows("27:" & <SPAN style="color:#00007F">CStr</SPAN>(Range("BR16").Value + 26)).RowHeight = 9.75<br>    <br>    Range("BS" & <SPAN style="color:#00007F">CStr</SPAN>(Range("BR16").Value + 26)).Select<br>    Application.Calculation = xlManual<br>    <SPAN style="color:#00007F">With</SPAN> ActiveCell<br>        <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">Until</SPAN> .Offset(0, -56).Value = "1st Event Row"<br>            <SPAN style="color:#00007F">If</SPAN> .Offset(0, -56).Value = 0 <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#007F00">' don't use copy/pastespecial, just set the values equal:</SPAN><br>                .Offset(-1, 0).Range("A1:CA1").Values = .Offset(0, 0).Range("A1:CA1").Values<br>                <SPAN style="color:#007F00">' could also be written as: _<br>                .offset(-1,0).resize(1,79).values = .offset(0,0).resize(1,79).values</SPAN><br>    <br>            <SPAN style="color:#00007F">Else</SPAN><br>                .Offset(-1, 0).Select<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Loop</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <br>    <SPAN style="color:#007F00">'Then delete rows that are not the "1st event row"</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> Range("N23").Value > 0 <SPAN style="color:#00007F">Then</SPAN><br>        Range("A27:DS50000").Select<br>        ActiveWorkbook.Worksheets("EventMerge").Sort.SortFields.Add Key:=Range( _<br>        "O27:O50000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _<br>        xlSortNormal<br>        <br>        ActiveSheet.Range("$A$26:$DS$50000").AutoFilter Field:=15, Criteria1:="0"<br>        Range("A27:A" & <SPAN style="color:#00007F">CStr</SPAN>(Range("BR16").Value + 26)).Select<br>        Selection.ClearContents<br>        Selection.EntireRow.Delete<br>    <SPAN style="color:#00007F">Else</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <br>    <SPAN style="color:#00007F">If</SPAN> ActiveSheet.FilterMode <SPAN style="color:#00007F">Then</SPAN><br>        ActiveSheet.ShowAllData<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <br>    Application.Calculation = xlAutomatic<br>    <br>    Sheets("EventMerge").Range("BS6").Value = Now()<br>    Range("BV5").Value = Range("BS7").Value<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[jdaywalt]

Unfortunately, I am not just using a copy/paste values. I also have to "skip blanks" because as the row below is copied to the row above, if the row above has data in some of its cells, I don't want to overwrite them. See my example below;

upper row:________data1.......data2
lower row:___________________________data3......data4


So that when the copy from lower to upper row is complete, the upper row will look like this:

upper row:_______data1......data2.....data3.....data4

If I just do "upper row.value" = "lower row.value", the "blank" cells from the lower row will overwrite the occupied cells in the upper row. That is my dilemma! Is there another solution you can recommend that will maintain the integrity of the cell contents on the upper rows as data is being copied up?

 

[sijpie]

The other way to do it, nearly as quick as the set values, but quicker than the copy paste, will be to load the two rows into an array, loop through each pair of values and adjust as required, then write the array back to the sheet.

Or if your mind is big enough, load the total range in an array and write back only once...


To do it (the first proposal) Dim a variant and load the array by setting it to the range

Dim aRowComp as Variant
aRowComp = .offset(0,0).resize(2,79).values 

Now the two rows are in the array and you can loop through

for i =1 to 79
   if aRowComp(2,i)<>vbnullstring then
       aRowComp(1,i) = aRowComp(2,i)
   end if
next i
' write array back to range

.offset(0,0).resize(2,79).values = aRowComp

 

[jdaywalt]

Hmmm... interesting. Assume I would then need to embed that within my overrideing loop statement that works across 1500 rows of data??

 

[sijpie]

yep, in priciple you can have these lines just like that in the code but you need to make sure do don't get messed up with where you are. The cell you check to see if it contains '1st Event Row' is column L i thnik, and is also in your array so you can check it in the array rather than reading it of the sheet, again speed increase. But then you need to change the order a bit.

Anyway if you want help with it let me know.

 

[jdaywalt]

Fantastic...I'll play around with this a bit and let you know if I run into any issues. Thanks so much!