[RESOLVED] Excel 2010 freezing when renaming multiple sheets

Hi everyone. I posted the macro below. I have a list of codes on my "Start Tab". From there I have a few macros that run before this one that takes the list of codes and creates a tab in the workbook for each code. Once that is done, the below macro goes to a specific URL code on our Intranet and opens it, copies it to the worksheet with the associated code. That's the whole code. Each time I run this part of the macro, Excel freezes. It's never in the same place. Sometimes it freezes very quickly, sometimes it runs through almost the entire list of 600 codes. Can you see what the issue is? I'm at a loss. I have googled this and looked everywhere for a solution but I can't find one. Please help!!!!!!!



Sub Update_Client_Tabs()
'Application.DisplayAlerts = False
Sheets("Start Tab").Select
Range("F7").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
sourcesheet = ActiveSheet.Name
For Each Cell In Selection
Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = Cell.Value
Range("A1").Select

ActiveCell.FormulaR1C1 = _
"=MID(CELL(""filename"",RC),FIND(""]"",CELL(""filename"",RC))+1,256)"
Range("B1").Select
ActiveCell.FormulaR1C1 = _
"=INDEX('Start Tab'!C6:C9,MATCH(R1C1,'Start Tab'!C6,0),4)"
Range("B1").Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("A2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",R1C1)"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A1000"), Type:=xlFillDefault
Range("A2:A1000").Select

Selection.FillDown


Dim qtsQueries As QueryTables
Dim qtQuery As QueryTable
Set qtsQueries = ActiveSheet.QueryTables
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Range("B2").Value, _
Destination:=ActiveSheet.Range("b4"))

.Name = Range("B2").Value
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False


End With
Range("$A$2:$A$1000").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

On Error Resume Next
Rows("1:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("3:3").Select
ActiveWindow.FreezePanes = True

Range("A4").Select
ActiveSheet.Buttons.Add(800, 5, 45, 25).Select
Selection.OnAction = "Back"
ActiveSheet.Shapes("Button 1").Select
Selection.Characters.Text = "Back"
Range("C1").Select
ActiveCell.FormulaR1C1 = _
"=MID(CELL(""filename"",RC[-2]),FIND(""]"",CELL(""Filename"",RC[-2]))+1,256)"

Worksheets(Worksheets.Count).Activate

Sheets(sourcesheet).Activate
Next Cell
'Application.DisplayAlerts = False

'Application.DisplayAlerts = True
Sheets("Start Tab").Select
End Sub

Does it freeze permanently, or is it just a long pause? If it appears to be permanent, how long did you wait before giving up, and what did you have to do to bail out?

This isn't in the right forum, but the mods will move it soon enough. However, the first thing I would do would be to get rid of the On Error Resume Next line. Comment it out, for now. That line will ignore any errors without you even knowing that something has gone wrong. If the right thing goes wrong, then everything after that could come unhinged. It's better to know what the problems are rather than trying to ignore them.

Thread moved to the Office Development forum.

Quote:

---

Originally Posted by Shaggy Hiker

Does it freeze permanently, or is it just a long pause? If it appears to be permanent, how long did you wait before giving up, and what did you have to do to bail out?

This isn't in the right forum, but the mods will move it soon enough. However, the first thing I would do would be to get rid of the On Error Resume Next line. Comment it out, for now. That line will ignore any errors without you even knowing that something has gone wrong. If the right thing goes wrong, then everything after that could come unhinged. It's better to know what the problems are rather than trying to ignore them.

---

I want to say that it is permanent. I waited about 15 minutes before killing it. I'll try commenting out that line. hopefully you're right and it will show me where the issue is.

Thanks.

I just tried it and it froze again.

please edit your original post to put code tags, so the code is more readable

how far does the code get before freezing?

Quote:

---

For Each Cell In Selection
Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = Cell.Value
Range("A1").Select

---

you are using a loop based on the selection object, but you keep selecting other ranges within the loop, i would expect this to cause issues when the selection changes

I guess I should first mention that I am working on learning VBA on my own out of necessity so I'm sure I'm not doing a lot of things correctly so any advice would be welcome. Having said that, I'm not sure what you mean by putting code tags on the original post. I have a list of about 600 3 digit letters in a worksheet labelled "Start Tab." Lets say in column A. Next to it is the corresponding Intranet site. The code looks for the Intranet site, copies it and pastes it in its corresponding worksheet with the same 3 digit code. Then it loops, goes back to the 2nd code and so on. Sometimes this code will run through 5 and then freeze, sometimes it will copy and paste a few hundred before freezing.
What do you mean by "you are using a loop based on the selection object, but you keep selecting other ranges within the loop, i would expect this to cause issues when the selection changes"??

What he means by this:

"you are using a loop based on the selection object, but you keep selecting other ranges within the loop, i would expect this to cause issues when the selection changes"

is that you are selecting a range here:

Code:

---

Range("F7").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select

---

then looping through the cells in that range here:

Code:

---

For Each Cell In Selection

---

then selecting other ranges (while still in the first range/loop), here:

Code:

---

Range("A1").Select

---

I'm trying to put a Macro button on each sheet. That is why that last line is there. Instead of trying to scroll through all the tabs, I put a Back button on each worksheet (part of the loop) and then a "goto" cell on the "Start Tab" where I can put the name of the sheet and the macro will jump to the correct tab. Is there a better way to do that?

My first thoughts were the same as westconn's, but then I tested it and realized how my thought processes have become influenced by working in the .Net framework with the concept of reference types.:o

I would wager that the problem is in:

Code:

---

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Range("B2").Value, _
Destination:=ActiveSheet.Range("b4"))

---

Have you set a breakpoint at this line and verified that the constructed connection string is valid?

I'm not sure how to do that.

can you give a example of what is in some your columns before you execute the code?

Sure thing. I have the following in columns F and G. Column F has our internal hospital code and Column G has a formula that shows the intranet connection where our information about the hospital is located. The list has anywhere from 5 codes to 600 codes so that part is a variable amount. There are tabs in the workbook that are renamed with what is in Column F (the first tab would be renamed ABK18 and so on). I have a separate macro button that does that which works fine. My goal is to create a loop that will copy everything on the intranet site, paste it in the worksheet and then create a back button with a macro linked to it (that selects the Start Tab worksheet) at the top of the page, then freeze the first 3 rows so the Back button won't disappear. If there's an easier way that will work then I'm all ears. That's the easiest way I could think of.

ABK18 ABK_div18_fact.htm#Client Representative

i would like to test the "queryTable" part, but can't get something meaningful in cell B2 in order to form the connection string.

if your workbook is not overly "proprietary," can you zip and attach? if that won't work, at least show us what is in B2 so we can build the connection string and test.

I can't send the whole file. That is proprietary but I can tell you that B2 is the intranet address that I am trying to get to. Does that help? Since this is a normal copy everything and paste, I guess any website would do the trick for an example?

Quote:

---

Originally Posted by stephan2531

I'm not sure how to do that.

---

Assuming that one was meant for me.

Go to that line in the code and press the F9 key (that key will toggle the breakpoint on/off); you should see a reddish dot show up at the left of the line. When you run your code, the execution will now stop at that line.

Now open the "Immediate Window" (Ctrl-G) and enter: ? Range("B2").Value
The "?" tells it to print out the value.

You can use the "F8" key to step through the successive lines of code looking for the source of the issue or press "F5" to resume processing.

TnTinMN - yes that was for you. I did what you asked and the value is returning the intranet address which i checked and is accurate. The loop works but only sometimes. could it be that the code could be cleaned up so there is less "select" or "activate" or something like that? Maybe that is causing the macro to freeze up sometimes?

There's no doubt that you should do less selecting and activating, but I'm not sure that's what's hanging you up.

When I tested adding a query table from a URL of my choosing, it took about 10 seconds to return the data. I'm assuming your code tries to continue right along before the data is there. Would that have an impact on the code that follows?

vbfbryce, is there a delay code or something that I can insert there to pause the macro so the URL can return the data before it continues?

Actually, you're already forcing it to wait by using this line:

Code:

---

.Refresh BackgroundQuery:=False

---

vbfbryce - I'm not sure if the hesitation would impact the code after or not. I just added a delay code (10 sec.) after the below code and ran it just for the fun of it. It didn't work.

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Range("B2").Value, _
Destination:=ActiveSheet.Range("b4"))

I know you looked at the connect string specifically, per TN's request, but maybe put some error trapping in so you can figure out if one of your many connections is causing you the problem, something like this:

Code:

---

On Error Resume Next
           
            wsNew.QueryTables.Add Connection:= _
                "URL;" & Range("B2").Value, _
                Destination:=ActiveSheet.Range("b4")
                .Name = Range("B2").Value
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlEntirePage
                .WebFormatting = xlWebFormattingNone
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh False
            End With
           
            If Err.Number <> 0 Then
                MsgBox Err.Description
                Stop
                Exit Sub
            End If

---

I just added your suggestion but it froze again. The problem I am having is that I can't DO anything after it freezes. I'm forced to hit Cntrl Alt Delete and close the program and then restart. I can't even see where the hang up is.

I would suggest breaking the code into chunks. For example, do nothing but add a sheet for each cell you have in your starting range. If that works, add in the first formula on each sheet, then the 2nd, etc.

I don't know if this will help, but it is an implementation of doing a query table with a query TimedOut feature.

You can run it as is to get a feel for it first before making the need modifications for your application. Note that it does the query in background.

Code:

---

Option Explicit

Private currentItemIndex As Integer
Private itemRange As Range
Private currentSheet As Worksheet

' Variables For Background Query monitoring
Private qt As QueryTable
Private QTIterations As Integer
Private QTTimedOut As Boolean
Private MaxSeconds As Integer

Public Sub Update_Client_Tabs()
    Set itemRange = Worksheets("Start Tab").Range("F7", Worksheets("Start Tab").Range("F7").End(xlDown))
    currentItemIndex = 1
    AddSheet
End Sub ' Update_Client_Tabs

Public Sub AddSheet()
    If currentItemIndex <= itemRange.Cells.Count Then
        Set currentSheet = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
        currentSheet.Name = itemRange.Cells(currentItemIndex)
        currentItemIndex = currentItemIndex + 1
        ' add other stuff to current sheet
       
        AddQueryTable
       
        ' setup for for QueryTable timeout
        QTIterations = 0
        MaxSeconds = 20 ' seconds
       
        CheckQueryRefreshState
    Else
        MsgBox "done"
    End If
End Sub ' AddSheet

Public Sub AddQueryTable()
    Dim url As String
    url = "URL;http://www.vbforums.com/forum.php"
    Set qt = currentSheet.QueryTables.Add(Connection:=url, Destination:=currentSheet.Range("A1"))
    With qt
        .Name = "Geocoder Query"
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=True
    End With
End Sub ' AddQueryTable

Public Sub CheckQueryRefreshState()
' Adpated from: XL97: Background Queries Suspended While Macro Executes
'              http://support.microsoft.com/default.aspx?scid=kb;en-us;157090

    Dim NextMethod As String
    Dim timeOffset As Double
   
    If qt.Refreshing Then
        'If the query is still refreshing, call the
        'CheckQueryRefreshState again in one second.
        If QTIterations = MaxSeconds Then
            QTTimedOut = True
            qt.CancelRefresh
            NextMethod = "PostQueryTableStuff"
            timeOffset = 0.25
        Else

            QTIterations = QTIterations + 1
            Debug.Print QTIterations
            Beep
            NextMethod = "CheckQueryRefreshState"
            timeOffset = 1#
        End If
    Else
       
        QTTimedOut = False
        NextMethod = "PostQueryTableStuff"
        timeOffset = 0.25
    End If
   
    Application.OnTime DateAdd("s", timeOffset, Now()), NextMethod
End Sub ' CheckQueryRefreshState

Public Sub PostQueryTableStuff()
    If QTTimedOut Then
        ' log error
        Stop
    Else
        ' add post query stuff
        Stop
    End If
    Application.OnTime DateAdd("s", 0.25, Now()), "AddSheet"
End Sub ' PostQueryTableStuff

---

Quote:

---

Destination:=ActiveSheet.Range("b4")

---

try to change every reference to active anything to a fully qualified range
like
workbooks("mybook.xls").sheets("somesheet").range("b4")

try to avoid selecting or activating anything, work with fully qualified ranges

create some timestamped logging so you can find where delays are occurring
if you log out to a text file, make sure to close everytime you append, you can then see the last entry before freezing to find what is causing then issue

Good ideas, Pete!

Stephan, if you want any assistance with the text logging Pete refers to, let us know.

OK, first, thank you all so much for putting up with my ignorance. This is taking way too much time to figure out but it will save me so much time if I can get it up and running. Rock and a hard place....

westconn1 - so you are saying that instead of me writing "Sheets(Sheet1).select", I can write "workbooks("mybook.xls").sheets("Sheet1")" and that will do the same thing? That's almost too easy!! Will the latter part work for both activate and select? Why do they have those commands if everyone that I've talked to about it tells me never to use them?

Also what do you mean by log out to a text file? I've never done (that I'm aware of) any timestamped logging before.

Thanks again for all of your help!

This is an example of how I log to a text file:

Code:

---

'need a reference to Microsoft Scripting Runtime
'Tools>>>References

Public counter As Long

Sub writeOut()
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
   
    Dim myPath As String
    myPath = "c:\yourPath\wFile.txt"    'change to your path, make sure file exists
   
    Dim stream As TextStream
    Set stream = fso.OpenTextFile(myPath, ForAppending)
   
    Dim strWrite As String
    strWrite = "test" & counter + 1
    counter = counter + 1
    'I'm writing something meaningless ("test1", etc.).  You could write the values of some of your variables, how many sheets are in your workbook, etc.
   
    stream.WriteLine strWrite
   
    stream.Close
    Set stream = Nothing
   
    Set fso = Nothing
End Sub

---

I call that sub at various places in my code to see what has happened.

I just changed all of code that had select or activate. See below for the full code. I ran it again just for fun and it is still freezing. It seems to be freezing right around when it is trying to get the data from the intranet site if that helps. I just don't understand why it works sometimes but not other times. Very weird.

Thanks again for all of your help!

Where is the code?

Oops. There's a couple of spots that created errors when I tried to change them but for the most part, they are all changed. I couldn't figure out the first two lines and the last 3.

Sub Update_Client_Tabs()

Sheets("Start Tab").Range("F7").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
sourcesheet = ActiveSheet.Name
For Each Cell In Selection
Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = Cell.Value
Range("A1").FormulaR1C1 = _
"=MID(CELL(""filename"",RC),FIND(""]"",CELL(""filename"",RC))+1,256)"
Range("B1").FormulaR1C1 = _
"=INDEX('Start Tab'!C6:C9,MATCH(R1C1,'Start Tab'!C6,0),4)"
Range("B1").Copy
Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").FormulaR1C1 = "=IF(RC[1]="""","""",R1C1)"
Range("A2").AutoFill Destination:=Range("A2:A1000"), Type:=xlFillDefault
Range("A2:A1000").FillDown

Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 8" 'clears temporary Internet files

On Error Resume Next

Dim qtsQueries As QueryTables
Dim qtQuery As QueryTable
Set qtsQueries = ActiveSheet.QueryTables
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Range("B2").Value, _
Destination:=ActiveSheet.Range("b4"))
.Name = Range("B2").Value
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False


End With

If Err.Number <> 0 Then
MsgBox Err.Description
Stop
Exit Sub
End If

Range("$A$2:$A$1000").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Rows("1:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("3:3").Select
ActiveWindow.FreezePanes = True
Range("A4").Buttons.Add(800, 5, 45, 25).OnAction = "Back"
ActiveSheet.Shapes("Button 1").Characters.Text = "Back"
Range("C1").FormulaR1C1 = _
"=MID(CELL(""filename"",RC[-2]),FIND(""]"",CELL(""Filename"",RC[-2]))+1,256)"

Worksheets(Worksheets.Count).Activate

Sheets(sourcesheet).Activate
Next Cell

Sheets("Start Tab").Select
End Sub

To change the first 2:

Code:

---

Dim wb As Workbook
    Dim wsStart As Worksheet
    Dim rng As Range
    Set wb = ActiveWorkbook
    Set wsStart = wb.Worksheets("Start Tab")
    Set rng = Range(wsStart.Range("f7"), wsStart.Range("f7").End(xlDown))
   
    For Each cel In rng
        '...
    Next

---

OK, now it kicked out at the line Activesheet.name = cell value. Can I use ActiveSheet.name = rng? or something like that?

Sub Update_Client_Tabs()
Dim wb As Workbook
Dim wsStart As Worksheet
Dim rng As Range
Set wb = ActiveWorkbook
Set wsStart = wb.Worksheets("Start Tab")
Set rng = Range(wsStart.Range("f7"), wsStart.Range("f7").End(xlDown))

For Each cel In rng
'Sheets("Start Tab").Range("F7").Select
'Range(ActiveCell, ActiveCell.End(xlDown)).Select
'sourcesheet = ActiveSheet.Name
'For Each Cell In Selection
Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = cell.Value
Range("A1").FormulaR1C1 = _
"=MID(CELL(""filename"",RC),FIND(""]"",CELL(""filename"",RC))+1,256)"
Range("B1").FormulaR1C1 = _
"=INDEX('Start Tab'!C6:C9,MATCH(R1C1,'Start Tab'!C6,0),4)"
Range("B1").Copy
Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").FormulaR1C1 = "=IF(RC[1]="""","""",R1C1)"
Range("A2").AutoFill Destination:=Range("A2:A1000"), Type:=xlFillDefault
Range("A2:A1000").FillDown

Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 8" 'clears temporary Internet files

On Error Resume Next

Dim qtsQueries As QueryTables
Dim qtQuery As QueryTable
Set qtsQueries = ActiveSheet.QueryTables
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Range("B2").Value, _
Destination:=ActiveSheet.Range("b4"))
.Name = Range("B2").Value
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False


End With

If Err.Number <> 0 Then
MsgBox Err.Description
Stop
Exit Sub
End If

Range("$A$2:$A$1000").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Rows("1:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("3:3").Select
ActiveWindow.FreezePanes = True
Range("A4").Buttons.Add(800, 5, 45, 25).OnAction = "Back"
ActiveSheet.Shapes("Button 1").Characters.Text = "Back"
Range("C1").FormulaR1C1 = _
"=MID(CELL(""filename"",RC[-2]),FIND(""]"",CELL(""Filename"",RC[-2]))+1,256)"

Worksheets(Worksheets.Count).Sheets(sourcesheet).Activate
Next

Sheets("Start Tab").Select
End Sub

Stephan,

If you define a currentSheet variable and assign the added sheet to it than you do not need use Activate/ActiveSheet; you just use that variable instead. Take a look at the coding style I used in post #25 for reference.

Code:

---

set mysht = workbooks("book1").sheets("xxx")
mysht.name = "newsheetname"

---

mysht still represents the same sheet even though the name has changed

OK, I've been messing with the code after googling this all day long. Since the macro seems to crap out whenever it tries to access the data from the "web" Some of the sites say to clear the cache every 20 or so "loops" I put in the below code but it clears the history after every loop so I have about 50 - 100 windows open saying that the history is being deleted BUT IT RAN all the way through. It didn't freeze!! Is there a way to change the below code to run only every 10th time?

Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 11"

Quote:

---

Originally Posted by stephan2531

It didn't freeze!!
Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 11"

---

I seen in one of your previous post that you were clearing the Temporary Internet Files (8), but it looks like you opted to nuke the History and cookies as well (11). I also saw those claims about clearing tempfiles helping, but you said it still failed with that code in there so I thought oh well.

Quote:

---

Originally Posted by stephan2531

Is there a way to change the below code to run only every 10th time?

---

Someone sounds frazzled!:wave:

Does (add a counter/If counter = 10/run code, reset counter) ring a bell.:eek:

Shell runs asynchronously, so it may be prudent to through this in to to give some time to process:

Application.Wait DateAdd("s", 30, Now()) ' 30 second pause

Ok, here is the final product just so you guys have closure. I added the reset counter code to reset after reaching 8 (thanks TnTinMN!!!!) and it works beautifully. That was a problem I've been working on for months here and there but finally decided to put my full attention to it until I figured it out. I couldn't have done it without you guys!!! Thanks so much! I guess the cache was the problem here. If you have a macro that does a lot of cutting and pasting of large amounts of data and it freezes, you will need to clear the cache every so often to fix the freezing. Learned a lot on this one!!

Sub Update_Client_Tabs()
Dim wb As Workbook
Dim wsStart As Worksheet
Dim rng As Range
Set wb = ActiveWorkbook
Set wsStart = wb.Worksheets("Start Tab")
Set rng = Range(wsStart.Range("f7"), wsStart.Range("f7").End(xlDown))
Dim counter As Integer

counter = 1

Sheets("Start Tab").Range("F7").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
sourcesheet = ActiveSheet.Name
For Each Cell In Selection
Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = Cell.Value
Range("A1").FormulaR1C1 = _
"=MID(CELL(""filename"",RC),FIND(""]"",CELL(""filename"",RC))+1,256)"
Range("B1").FormulaR1C1 = _
"=INDEX('Start Tab'!C6:C9,MATCH(R1C1,'Start Tab'!C6,0),4)"
Range("B1").Copy
Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").FormulaR1C1 = "=IF(RC[1]="""","""",R1C1)"
Range("A2").AutoFill Destination:=Range("A2:A1000"), Type:=xlFillDefault
Range("A2:A1000").FillDown



On Error Resume Next
Dim sURL As String
Dim qtsQueries As QueryTables
Dim qtQuery As QueryTable
Set qtsQueries = ActiveSheet.QueryTables

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Range("B2").Value, _
Destination:=ActiveSheet.Range("b4"))
.Name = Range("B2").Value
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

If Err.Number <> 0 Then
MsgBox Err.Description
Stop
Exit Sub
End If
Range("a2").Select

Range("$A$2:$A$1000").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Rows("1:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("3:3").Select
ActiveWindow.FreezePanes = True
Range("A4").Buttons.Add(800, 5, 45, 25).OnAction = "Back"
ActiveSheet.Shapes("Button 1").Characters.Text = "Back"
Range("C1").FormulaR1C1 = _
"=MID(CELL(""filename"",RC[-2]),FIND(""]"",CELL(""Filename"",RC[-2]))+1,256)"

Worksheets(Worksheets.Count).Sheets(sourcesheet).Activate

counter = counter + 1

If counter > 8 Then
counter = 1
Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 11"
End If

Next

Sheets("Start Tab").Select
End Sub