Why would Excel react this way to this process?

[Shaka215]

Hi fellow Guru's... I am curious as to why the following is causing my
macro to slow down after it loops like 50 times...

I have written some code to do the following...

1. Delete a sheet called "DataPull" and create a new spreadsheet
called "DataPull"
2. Conduct a web query from a website
3. Manipulate the imported data and export it
4. Jump down to the next cell
5. Go back to step # 1

Rinse and repeate... the problem is the code is lighting fast up until
the 50th loop. I don't understand why it would slow down if the
process didn't change after the first 49 numbers. The only thing that
is changing is the spreadsheet # when it's created. Anyone have any
idea as to why this would slow the macro down to a crawl once it hits
the loop at 50?

Much appreciated!

-Shaka215

[cht13er]

Can you post the code? You'll likely get a better answer if you do :)

Chris

[cht13er]

On Apr 14, 8:06 pm, Shaka215 <Shaka...@gmail.com> wrote:

It could be that the 50th query is slower?? Are you pulling similar
data from one website? Or are you switching up websites?

C

[Charlie]

Why? I don't know. But you can speed up some of your code in this manner.
For one, I fail to see why it is necessary to delete and recreate a sheet.
Simply "refresh" the sheet by deleting all the cells:

ThisWorkbook.Sheets("DataPull").Select
Cells.Delete

Next, avoid selecting cells, simply put the data in them. Instead of:

Range("I201").Select
ActiveCell.Value = "STOP"
Range("G201").Select
ActiveCell.Value = "STOP"
Range("D201").Select
ActiveCell.Value = "STOP"

Do This:

Range("I201") = "STOP"
Range("G201") = "STOP"
Range("D201") = "STOP"

(It's much easier on your typing fingers too!)

Likewise in your Do Loop. Too much activating, selecting, and copying of
individual cells. There might be some way to accumulate all of the data that
you want from one column into one array, then paste the entire array into the
desired column of the "DataExport" sheet all at once.

Option Base 1 'at the top of the module

' in your CommandButton1_Click Sub

Dim Cell As Range
Dim List As Variant
Dim nItem As Long

ReDim List(1)

For Each Cell In Range("I1:I200") 'Do this and you won't need to look for
"STOP"
If Cell = "Something" Then
nItem = nItem + 1
ReDim Preserve List(nItem)
List(nItem) = Cell
End If
Next Cell

'Here paste the entire array into the export sheet

Sheets("DataExport").Range("A1:" & "A" & nItem) = List

Try stuff like that.

Regards,
Charlie

"Shaka215" wrote:

> > Chris- Hide quoted text -
> >
> > - Show quoted text -
>
>
> Private Sub CommandButton1_Click()
> '=================
> Dim c
> For Each c In UserForm1.Spreadsheet1.Selection
>
>
> Application.CutCopyMode = False
> Application.DisplayAlerts = False
> ThisWorkbook.Sheets("DataPull").Select
> ActiveWindow.SelectedSheets.Delete
> Sheets("DATALINK").Select
> Sheets.Add
> ActiveSheet.Name = "DataPull"
> '=================
> Range("I201").Select
> ActiveCell.Value = "STOP"
> Range("G201").Select
> ActiveCell.Value = "STOP"
> Range("D201").Select
> ActiveCell.Value = "STOP"
>
> Application.CutCopyMode = False
> UserForm1.Spreadsheet1.Sheets("Sheet1").Select
> c.Select
> c.Offset(0, 1).Select
>
> With ActiveSheet.QueryTables.Add(Connection:="URL; http://www.something.com/link/,"
> & c & UserForm1.TextBox77.Value,
> Destination:=ThisWorkbook.Sheets("DataPull").Range("A1"))
> .Name = "allResults"
> .FieldNames = True
> .RowNumbers = False
> .FillAdjacentFormulas = False
> .PreserveFormatting = True
> .RefreshOnFileOpen = False
> .BackgroundQuery = True
> .RefreshStyle = xlInsertDeleteCells
> .SavePassword = False
> .SaveData = False
> .AdjustColumnWidth = False
> .RefreshPeriod = 0
> .WebSelectionType = xlSpecifiedTables
> .WebFormatting = xlWebFormattingNone
> .WebTables = "7"
> .WebPreFormattedTextToColumns = True
> .WebConsecutiveDelimitersAsOne = True
> .WebSingleBlockTextImport = False
> .WebDisableDateRecognition = False
> .WebDisableRedirections = False
> .Refresh BackgroundQuery:=False
> End With
>
> Do
> ActiveCell.Offset(1, 0).Select
> If Len(ActiveCell.Value) = 0 Then
> ActiveCell.Offset(1, 0).Select
> End If
> If ActiveCell.Value = "Something" Then
> ActiveCell.Value = ActiveCell.Offset(0, 1).Value
> ActiveCell.Select
> Selection.Copy
> ThisWorkbook.Sheets("DataExport").Select
> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> SkipBlanks:=False, Transpose:=False
> ActiveCell.Offset(1, 0).Select
> ThisWorkbook.Sheets("DataPull").Select
> ActiveCell.Offset(1, 0).Select
> End If
> Loop Until ActiveCell.Value = "STOP"
> Next C
> End Sub
>