Crashing Macro

[ConradBartimus]

I am in the middle of a rather Large Build.

I was tasked with adding another pull to the tool. For each Data pull, I have 147 networks that are being pulled. The macro I have right now, will pull the data once, place it in a sheet, use a combination of 26 formulas to grab the Data needed from the pull. The Macro then copies those fomulas into new cells and once it finishes pasting, it will move onto the next network in the Data Pull. I have built this same macro probably 50 times (and thats not exaggerating). I have not run into an issue, however I think I may have made the tool a little too large when building it. The VBA for the macro is below, is there a way to consolidate this.


Sub Tcap()

'Macro pulls everything on the RodeoCE Page, if you need more URLS to pull just add more to the Epicenter page in the order you want them displayed on the Display Page.

Dim httpRequest As XMLHTTP 'XML V3.0(menu:tools, references)
Dim DataObj As New MSForms.DataObject 'Forms 2.0(menu:tools, references)
Dim urlStr, tableStr As String
Dim arrayData As Variant
Dim arrayRowCalc As Integer
Dim pasteArray As Integer

Worksheets("TcapCenter").Select
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"

counter = 5

j = 1

While IsEmpty(ThisWorkbook.Sheets("Tclink").Cells(j, 1)) = False

For i = 1 To 1

If ThisWorkbook.Sheets("Tclink").Cells(j, i).Value <> "" Then
data_url = ThisWorkbook.Sheets("Tclink").Cells(j, i)
Worksheets("TcapData").Select
ActiveSheet.Cells.ClearContents
Set httpRequest = New XMLHTTP
httpRequest.Open "GET", data_url, "False"
httpRequest.Send ""
tableStr = httpRequest.responseText

DataObj.SetText tableStr
DataObj.PutInClipboard


Range("A1").Select
ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True

End If
Range("A1").Select
Do Until ActiveCell.Text = "Label"
Selection.EntireRow.Delete
Loop

Worksheets("TcapCenter").Select
Columns("C:D").Select
Selection.ClearContents
Range("B1").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B4").Select
ActiveCell.FormulaR1C1 = _
"=IF(TcapData!R[-3]C[-1]="""","""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(TcapData!R[-1]C[-1],""ProcessPath PP"",""""),"" p100 "",""""),""1 - "",""""))"
Range("B4").Select
Selection.AutoFill Destination:=Range("B4:B30"), Type:=xlFillDefault
Range("B4:B30").Select
Selection.Copy
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("B3").Select
Selection.Copy
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

If Cells(1, 2).Value <> "" Then
Cells(1, counter + 1).Value = Cells(3, 3).Value
Cells(2, counter + 1).Value = Cells(4, 3).Value
Cells(3, counter + 1).Value = Cells(5, 3).Value
Cells(4, counter + 1).Value = Cells(6, 3).Value
Cells(5, counter + 1).Value = Cells(7, 3).Value
Cells(6, counter + 1).Value = Cells(8, 3).Value
Cells(7, counter + 1).Value = Cells(9, 3).Value
Cells(8, counter + 1).Value = Cells(10, 3).Value
Cells(9, counter + 1).Value = Cells(11, 3).Value
Cells(10, counter + 1).Value = Cells(12, 3).Value
Cells(11, counter + 1).Value = Cells(13, 3).Value
Cells(12, counter + 1).Value = Cells(14, 3).Value
Cells(13, counter + 1).Value = Cells(15, 3).Value
Cells(14, counter + 1).Value = Cells(16, 3).Value
Cells(15, counter + 1).Value = Cells(17, 3).Value
Cells(16, counter + 1).Value = Cells(18, 3).Value
Cells(17, counter + 1).Value = Cells(19, 3).Value
Cells(18, counter + 1).Value = Cells(20, 3).Value
Cells(19, counter + 1).Value = Cells(21, 3).Value
Cells(20, counter + 1).Value = Cells(22, 3).Value
Cells(21, counter + 1).Value = Cells(23, 3).Value
Cells(22, counter + 1).Value = Cells(24, 3).Value
Cells(23, counter + 1).Value = Cells(25, 3).Value
Cells(24, counter + 1).Value = Cells(26, 3).Value
Cells(25, counter + 1).Value = Cells(27, 3).Value
Cells(26, counter + 1).Value = Cells(28, 3).Value
Cells(27, counter + 1).Value = Cells(29, 3).Value
Cells(1, counter + 2).Value = Cells(3, 4).Value
Cells(2, counter + 2).Value = Cells(4, 4).Value
Cells(3, counter + 2).Value = Cells(5, 4).Value
Cells(4, counter + 2).Value = Cells(6, 4).Value
Cells(5, counter + 2).Value = Cells(7, 4).Value
Cells(6, counter + 2).Value = Cells(8, 4).Value
Cells(7, counter + 2).Value = Cells(9, 4).Value
Cells(8, counter + 2).Value = Cells(10, 4).Value
Cells(9, counter + 2).Value = Cells(11, 4).Value
Cells(10, counter + 2).Value = Cells(12, 4).Value
Cells(11, counter + 2).Value = Cells(13, 4).Value
Cells(12, counter + 2).Value = Cells(14, 4).Value
Cells(13, counter + 2).Value = Cells(15, 4).Value
Cells(14, counter + 2).Value = Cells(16, 4).Value
Cells(15, counter + 2).Value = Cells(17, 4).Value
Cells(16, counter + 2).Value = Cells(18, 4).Value
Cells(17, counter + 2).Value = Cells(19, 4).Value
Cells(18, counter + 2).Value = Cells(20, 4).Value
Cells(19, counter + 2).Value = Cells(21, 4).Value
Cells(20, counter + 2).Value = Cells(22, 4).Value
Cells(21, counter + 2).Value = Cells(23, 4).Value
Cells(22, counter + 2).Value = Cells(24, 4).Value
Cells(23, counter + 2).Value = Cells(25, 4).Value
Cells(24, counter + 2).Value = Cells(26, 4).Value
Cells(25, counter + 2).Value = Cells(27, 4).Value
Cells(26, counter + 2).Value = Cells(28, 4).Value
Cells(27, counter + 2).Value = Cells(29, 4).Value
counter = counter + 2
End If


Next


j = j + 1


Wend

End Sub

 

[RedBeard]

Quite a few select statements you can get rid of.
The If Cells(1,2) bit at the end can be made into a for loop quite easily.

Start with that and you'll have reduced the code by quite a large amount.
Don't forget to use the CODE tags though when you post code on the forums. Good luck.