Thanks in advance! I'm fairly new to Excel VBA so I welcome all criticism and advice! This is a routine I wrote to streamline analysis I need to do that originally took 1.5 hours and now takes about 4 minutes total run time. I'm fairly certain this part of stack is for code review, but if this is off topic please let me know and I will delete immediately. Thanks again. Option Explicit #If VBA7 And Win64 Then Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" ( _ ByVal pCaller As LongPtr, _ ByVal szURL As String, _ ByVal szFileName As String, _ ByVal dwReserved As LongPtr, _ ByVal lpfnCB As LongPtr _ ) As Long Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _ Alias "DeleteUrlCacheEntryA" ( _ ByVal lpszUrlName As String _ ) As Long #Else Private Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" ( _ ByVal pCaller As Long, _ ByVal szURL As String, _ ByVal szFileName As String, _ ByVal dwReserved As Long, _ ByVal lpfnCB As Long _ ) As Long Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _ Alias "DeleteUrlCacheEntryA" ( _ ByVal lpszUrlName As String _ ) As Long #End If Public Const ERROR_SUCCESS As Long = 0 Public Const BINDF_GETNEWESTVERSION As Long = &H10 Public Const INTERNET_FLAG_RELOAD As Long = &H80000000 Public Const csURL As String = "http://www.cmegroup.com/CmeWS/exp/voiProductDetailsViewExport.ctl?media=xls&tradeDate=×d×&reportType=P&productId=×p×" Sub Pull_CME_Data() Dim getBook As String, OiProductCodesArray() As String Dim cmeDataBook As Workbook Dim data As Worksheet, controlPanel As Worksheet, lo As Worksheet, wa As Worksheet, sevenA As Worksheet, oh As Worksheet, at As Worksheet, ob As Worksheet, ra As Worksheet, cvr As Worksheet, ln As Worksheet, wtioi As Worksheet, rboboi As Worksheet, ethanoloi As Worksheet, heatoi As Worksheet, sevenaoi As Worksheet, waoi As Worksheet, ngoi As Worksheet, atoi As Worksheet, raoi As Worksheet, volumeSheet As Worksheet Dim ClearWshtsArray As Variant, OiWshtsArray As Variant Dim WshtNameCrnt As Variant, OiWshtsCrnt As Variant Dim oiProductCodesArrayCounter As Integer 'Initial declarations and setup getBook = ActiveWorkbook.Name Set cmeDataBook = Workbooks(getBook) Set data = cmeDataBook.Sheets("Data") Set controlPanel = cmeDataBook.Sheets("Control Panel") Set lo = cmeDataBook.Sheets("Lo") Set wa = cmeDataBook.Sheets("Wa") Set sevenA = cmeDataBook.Sheets("7A") Set oh = cmeDataBook.Sheets("oh") Set at = cmeDataBook.Sheets("at") Set ob = cmeDataBook.Sheets("Ob") Set ra = cmeDataBook.Sheets("Ra") Set cvr = cmeDataBook.Sheets("CVR") Set ln = cmeDataBook.Sheets("Ln") Set wtioi = cmeDataBook.Sheets("WtiOI") Set rboboi = cmeDataBook.Sheets("RbobOI") Set ethanoloi = cmeDataBook.Sheets("EthanolOI") Set heatoi = cmeDataBook.Sheets("HeatOI") Set sevenaoi = cmeDataBook.Sheets("7AOI") Set waoi = cmeDataBook.Sheets("WAOI") Set ngoi = cmeDataBook.Sheets("NGOI") Set atoi = cmeDataBook.Sheets("ATOI") Set raoi = cmeDataBook.Sheets("RAOI") Set volumeSheet = cmeDataBook.Sheets("Total Volume By Product (CME)") 'Sets three arrays for iteration through different sheets ClearWshtsArray = Array(data.Name, lo.Name, wa.Name, sevenA.Name, oh.Name, at.Name, ob.Name, ra.Name, _ cvr.Name, ln.Name, wtioi.Name, rboboi.Name, ethanoloi.Name, heatoi.Name, sevenaoi.Name, waoi.Name, _ raoi.Name) OiWshtsArray = Array(wtioi.Name, rboboi.Name, ethanoloi.Name, heatoi.Name, sevenaoi.Name, waoi.Name, ngoi.Name, atoi.Name, raoi.Name) OiProductCodesArray() = Split(controlPanel.Cells(4, 13).Value2, "or") On Error GoTo bailOut 'Preparation for execution Application.ScreenUpdating = False Application.StatusBar = True 'Clears data sheets of anything prior For Each WshtNameCrnt In ClearWshtsArray Worksheets(WshtNameCrnt).Activate With Worksheets(WshtNameCrnt) .UsedRange.Clear End With Next WshtNameCrnt Call GetTotalVolumeData(volumeSheet, controlPanel) 'For CSV data file controlPanel.Activate Cells(2, 1).Select Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True Workbooks.Open Filename:="ftp://ftp.cmegroup.com/pub/settle/nymex_option.csv" Windows("nymex_option.csv").Visible = True 'Copies data and transfers to data tab Cells.Select Selection.Copy data.Activate With data .Cells(1, 1).Select .Paste .Cells(1, 1).Select End With 'Clears clipboard and closes CSV file to avoid potential contamination Application.CutCopyMode = False Windows("nymex_option.csv").Activate Application.DisplayAlerts = False Workbooks("nymex_option.csv").Close 'Brings OI data by product For oiProductCodesArrayCounter = 0 To UBound(OiProductCodesArray) Call GetOiData(OiProductCodesArray(oiProductCodesArrayCounter), Sheets(OiWshtsArray(oiProductCodesArrayCounter)), controlPanel) Next oiProductCodesArrayCounter 'Gets Lo Data sorted and cleaned Call seperateData(cmeDataBook, data, lo, "lo", 1500) 'Get WA data, format and paste Call seperateData(cmeDataBook, data, wa, "wa", 100) 'Get 7A data, format and paste Call seperateData(cmeDataBook, data, sevenA, "7a", 100) 'Get OH data, format and paste Call seperateData(cmeDataBook, data, oh, "oh", 100) 'Get AT data, format and paste Call seperateData(cmeDataBook, data, at, "at", 5) 'Get OB data, format and paste Call seperateData(cmeDataBook, data, ob, "ob", 100) 'Get RA data, format and paste Call seperateData(cmeDataBook, data, ra, "ra", 5) 'Get Ethanol Data, format and paste Call seperateData(cmeDataBook, data, cvr, "cvr", 5) 'Get Ln Data, format and paste Call seperateData(cmeDataBook, data, ln, "ln", 1000) 'Excel standard function cleanup Application.ScreenUpdating = True Application.StatusBar = False data.Activate Range(Selection, Selection.End(xlToRight)).Select Selection.AutoFilter controlPanel.Activate MsgBox ("Data dump file successfully pulled and analyzed") Exit Sub 'Error handler for routine wide errors bailOut: Application.ScreenUpdating = True Application.StatusBar = False controlPanel.Activate MsgBox ("Data dump file has failed. Please check hyperlink, sheet names, date, and try again.") End Sub Sub GetTotalVolumeData(volumeSheet As Worksheet, controlSheet As Worksheet) Dim getBook As String, energy As String Dim newDataBook As Workbook Dim newDataSheet As Worksheet Dim lRow As Long, dataBookLRow As Long Dim ProductCodes() As String Dim counter As Integer 'Sets string variables and array energy = "Energy" ProductCodes() = Split(controlSheet.Cells(2, 17).Value2, "or") Workbooks.Open Filename:=controlSheet.Cells(2, 8) getBook = ActiveWorkbook.Name 'Set workbook name Set newDataBook = Workbooks(getBook) Set newDataSheet = newDataBook.Sheets(1) dataBookLRow = newDataSheet.Cells(newDataSheet.Rows.Count, "A").End(xlUp).Row For counter = 0 To UBound(ProductCodes) 'Counter iterating over the array to capture all the products Call ProcessVolumeData(volumeSheet, ProductCodes(counter), newDataBook, dataBookLRow, controlSheet) Next Application.DisplayAlerts = False newDataBook.Close Application.DisplayAlerts = True End Sub Sub ProcessVolumeData(volumeSheet As Worksheet, product As String, newDataBook As Workbook, dataBookLRow As Long, controlSheet As Worksheet) Dim lRow As Long 'Finds lRow of Volume Sheet lRow = volumeSheet.Cells(volumeSheet.Rows.Count, "B").End(xlUp).Row newDataBook.Activate 'WTI American With newDataBook.Sheets(1) Cells(5, 1).Select Range(Selection, Selection.End(xlToRight)).Select Selection.AutoFilter Selection.AutoFilter Field:=6, Criteria1:="=" & "Energy" Selection.AutoFilter Field:=1, Criteria1:="=" & Trim(product) Range("A6:M" & dataBookLRow).SpecialCells(xlCellTypeVisible).Select Selection.Copy End With volumeSheet.Activate With volumeSheet .Cells((lRow + 1), 2).Select .Paste .Cells((lRow + 1), 2).Select .Cells((lRow + 1), 1) = controlSheet.Cells(1, 5).Value End With End Sub Private Function seperateData(cmeDataBook As Workbook, data As Worksheet, productSheet As Worksheet, product As String, minimumVal As Integer) 'Finds product code in data table, formats it, and pastes into the relevant sheet Dim rownum As Integer Dim lRow As Integer Dim counter As Integer Dim contract As String Dim productOiSheet As Worksheet data.Activate Cells(1, 1).Select Range(Selection, Selection.End(xlToRight)).Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="=" & product Selection.AutoFilter Field:=18, Criteria1:=">=" & minimumVal Cells(1, 1).Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy productSheet.Activate With productSheet .Cells(1, 1).Select .Paste .Cells(1, 1).Select End With Application.CutCopyMode = False Selection.Sort Key1:=Range("R2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'Prevents unecessary formatting of empty cells If IsEmpty(Cells(2, 1)) = True Then GoTo Skip End If 'finds last row and sets row number lRow = productSheet.Cells(productSheet.Rows.Count, "A").End(xlUp).Row rownum = 2 'Pastes Product Symbol into second column header and deletes first column productSheet.Cells(1, 2) = productSheet.Cells(2, 1) 'Builds product code For counter = rownum To lRow Select Case productSheet.Cells(counter, 2) Case 1 productSheet.Cells(counter, 2) = "F" & Right(productSheet.Cells(counter, 3), 2) Case 2 productSheet.Cells(counter, 2) = "G" & Right(productSheet.Cells(counter, 3), 2) Case 3 productSheet.Cells(counter, 2) = "H" & Right(productSheet.Cells(counter, 3), 2) Case 4 productSheet.Cells(counter, 2) = "J" & Right(productSheet.Cells(counter, 3), 2) Case 5 productSheet.Cells(counter, 2) = "K" & Right(productSheet.Cells(counter, 3), 2) Case 6 productSheet.Cells(counter, 2) = "M" & Right(productSheet.Cells(counter, 3), 2) Case 7 productSheet.Cells(counter, 2) = "N" & Right(productSheet.Cells(counter, 3), 2) Case 8 productSheet.Cells(counter, 2) = "Q" & Right(productSheet.Cells(counter, 3), 2) Case 9 productSheet.Cells(counter, 2) = "U" & Right(productSheet.Cells(counter, 3), 2) Case 10 productSheet.Cells(counter, 2) = "V" & Right(productSheet.Cells(counter, 3), 2) Case 11 productSheet.Cells(counter, 2) = "X" & Right(productSheet.Cells(counter, 3), 2) Case 12 productSheet.Cells(counter, 2) = "Z" & Right(productSheet.Cells(counter, 3), 2) End Select Next 'changes C and P to puts For counter = rownum To lRow Select Case productSheet.Cells(counter, 5) Case "P" productSheet.Cells(counter, 5) = "PUT" Case "C" productSheet.Cells(counter, 5) = "CALL" End Select Next 'General formatting for each analyzed sheet Columns("C:D").Select Selection.Delete Shift:=xlToLeft Columns("A:A").Select Selection.Delete Shift:=xlToLeft Columns("E:L").Select Selection.Delete Shift:=xlToLeft Columns("H:H").Select Selection.Delete Shift:=xlToLeft Columns("H:J").Select Selection.Delete Shift:=xlToLeft productSheet.Cells(1, 8) = "OI" productSheet.Cells(1, 9) = "Chg In OI" Select Case Cells(1, 1) Case "LO" Set productOiSheet = cmeDataBook.Sheets("WtiOI") Case "WA" Set productOiSheet = cmeDataBook.Sheets("WAOI") Case "7A" Set productOiSheet = cmeDataBook.Sheets("7AOI") Case "OH" Set productOiSheet = cmeDataBook.Sheets("HeatOI") Case "AT" Set productOiSheet = cmeDataBook.Sheets("ATOI") Case "OB" Set productOiSheet = cmeDataBook.Sheets("RbobOI") Case "RA" Set productOiSheet = cmeDataBook.Sheets("RAOI") Case "CVR" Set productOiSheet = cmeDataBook.Sheets("EthanolOI") Case "LN" Set productOiSheet = cmeDataBook.Sheets("NGOI") End Select Range("C2:C" & lRow).NumberFormat = "###.00" Call AnalyzeOiData(lRow, productOiSheet, productSheet, rownum) Columns("A:i").EntireColumn.AutoFit Range("A1:i1").Select Selection.Font.Bold = True Range(Selection, Selection.End(xlDown)).Select With Selection .EntireColumn.AutoFit .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ActiveWindow.SmallScroll Down:=-6 productSheet.Select Rows("1:1").RowHeight = 42 Rows("1:1").RowHeight = 26.25 Rows("1:1").RowHeight = 39.75 'Skips formatting practices for products that did not fit the value minimum Skip: 'Do nothing skip formatting End Function Sub FormatData(dataT As Worksheet) 'Formats Data T Dim rownum As Integer Dim lRow As Integer Dim counter As Integer dataT.Activate 'finds last row and sets row number lRow = dataT.Cells(dataT.Rows.Count, "A").End(xlUp).Row rownum = 2 For counter = rownum To lRow Select Case dataT.Cells(counter, 2) Case 1 dataT.Cells(counter, 2) = "F" & Right(dataT.Cells(counter, 3), 2) Case 2 dataT.Cells(counter, 2) = "G" & Right(dataT.Cells(counter, 3), 2) Case 3 dataT.Cells(counter, 2) = "H" & Right(dataT.Cells(counter, 3), 2) Case 4 dataT.Cells(counter, 2) = "J" & Right(dataT.Cells(counter, 3), 2) Case 5 dataT.Cells(counter, 2) = "K" & Right(dataT.Cells(counter, 3), 2) Case 6 dataT.Cells(counter, 2) = "M" & Right(dataT.Cells(counter, 3), 2) Case 7 dataT.Cells(counter, 2) = "N" & Right(dataT.Cells(counter, 3), 2) Case 8 dataT.Cells(counter, 2) = "Q" & Right(dataT.Cells(counter, 3), 2) Case 9 dataT.Cells(counter, 2) = "U" & Right(dataT.Cells(counter, 3), 2) Case 10 dataT.Cells(counter, 2) = "V" & Right(dataT.Cells(counter, 3), 2) Case 11 dataT.Cells(counter, 2) = "X" & Right(dataT.Cells(counter, 3), 2) Case 12 dataT.Cells(counter, 2) = "Z" & Right(dataT.Cells(counter, 3), 2) End Select Next 'changes C and P to puts For counter = rownum To lRow Select Case dataT.Cells(counter, 5) Case "P" dataT.Cells(counter, 5) = "PUT" Case "C" dataT.Cells(counter, 5) = "CALL" End Select Next 'Formats strikes and basic formatting dataT.Range("F2:F" & lRow).NumberFormat = "###.00" dataT.Columns("H:O").Select Selection.Delete Shift:=xlToLeft dataT.Columns("T:T").Select Selection.Delete Shift:=xlToLeft dataT.Columns("C:D").Select Selection.Delete Shift:=xlToLeft End Sub Sub GetOiData(productID As String, targetSheet As Worksheet, controlPanel As Worksheet) 'Function access OI data from the CME website and copies it into the book for all products Dim filePath As String Dim reportDate As String Dim w As Long, ret As Long, sWAN As String, sLAN As String, sNAM As String Application.DisplayAlerts = False reportDate = Format(controlPanel.Cells(1, 5).Value, "yyyymmdd") 'sets potential file name and environTMP sNAM = Format(controlPanel.Cells(1, 5).Value, "\C\M\E\_OIL\_yyyymmdd") sLAN = Environ("TMP") & Chr(92) & Format(controlPanel.Cells(1, 5).Value, "\C\M\E\_OIL\_yyyymmdd.xl\s") 'Testing for error sLAN If CBool(Len(Dir(sLAN, vbNormal))) Then Kill sLAN sWAN = Replace(Replace(csURL, _ "×d×", Format(controlPanel.Cells(1, 5).Value, "yyyymmdd")), _ "×p×", productID) ret = URLDownloadToFile(0&, sWAN, sLAN, BINDF_GETNEWESTVERSION, 0&) If ret = ERROR_SUCCESS Then With Workbooks.Open(Filename:=sLAN, ReadOnly:=True) .Worksheets(1).Name = sNAM .Worksheets(1).UsedRange.Select Selection.Copy targetSheet.Activate With targetSheet .Cells(1, 1).Select .Paste End With .Worksheets(sNAM).Activate .Close savechanges:=False End With Kill sLAN Else If CBool(Err.Number) Then MsgBox (Err.Number & ": " & Err.Description) Else MsgBox ("Unable to download the file") End If Err.Clear End If End Sub Sub AnalyzeOiData(lRow As Integer, oiDataSheet As Worksheet, productSheet As Worksheet, rownum As Integer) Dim counter As Integer Dim monthExp As String Dim oiLocationFinder As Range Dim strikeRan As Range Dim optStrike As Long Dim locStor As Integer Dim strikeLoc As Range Dim emptyCounter As Integer Dim continue As Boolean For counter = rownum To lRow continue = True 'Returns formatted monthcode for finding the different months of expiry embedded in the OI data monthExp = GetMonthCode(productSheet.Cells(counter, 1), productSheet.Cells(counter, 2)) 'multiplies the strike by 100 in an attempt to match the format in the OI sheet If productSheet.Cells(1, 1) = "OH" Or productSheet.Cells(1, 1) = "AT" Or productSheet.Cells(1, 1) = "OB" Then optStrike = productSheet.Cells(counter, 3).Value * 10000 ElseIf productSheet.Cells(1, 1) = "LN" Then optStrike = productSheet.Cells(counter, 3).Value * 1000 Else optStrike = productSheet.Cells(counter, 3).Value * 100 End If 'Sets OI finder in order to access Row data Set oiLocationFinder = oiDataSheet.Columns(1).Find(monthExp) locStor = oiLocationFinder.Row oiDataSheet.Activate Cells(locStor, 1).Select emptyCounter = locStor Do DoEvents If Cells(emptyCounter, 1) = optStrike Then continue = False Set strikeLoc = Range("A" & emptyCounter) ElseIf IsEmpty(Cells(emptyCounter, 1)) = True Then continue = False Else emptyCounter = emptyCounter + 1 End If Loop Until continue = False If strikeLoc Is Nothing Then GoTo Skip End If locStor = strikeLoc.Row productSheet.Cells(counter, 8) = oiDataSheet.Cells(locStor, 9) productSheet.Cells(counter, 9) = oiDataSheet.Cells(locStor, 10) Skip: If IsEmpty(productSheet.Cells(counter, 8)) = True And IsEmpty(productSheet.Cells(counter, 9)) = True Then productSheet.Cells(counter, 8) = "NA" productSheet.Cells(counter, 9) = "NA" End If Set oiLocationFinder = Nothing Next End Sub Function GetMonthCode(exp As String, optionType As String) As String 'Formats month code so that it is readable and can be located in OI tables Dim monthYear As String Dim year As Integer year = Right(exp, 2) Select Case exp Case "F" & year monthYear = "JAN" & " " & Right(exp, 2) & " " Case "G" & year monthYear = "FEB" & " " & Right(exp, 2) & " " Case "H" & year monthYear = "MAR" & " " & Right(exp, 2) & " " Case "J" & year monthYear = "APR" & " " & Right(exp, 2) & " " Case "K" & year monthYear = "MAY" & " " & Right(exp, 2) & " " Case "M" & year monthYear = "JUN" & " " & Right(exp, 2) & " " Case "N" & year monthYear = "JUL" & " " & Right(exp, 2) & " " Case "Q" & year monthYear = "AUG" & " " & Right(exp, 2) & " " Case "U" & year monthYear = "SEP" & " " & Right(exp, 2) & " " Case "V" & year monthYear = "OCT" & " " & Right(exp, 2) & " " Case "X" & year monthYear = "NOV" & " " & Right(exp, 2) & " " Case "Z" & year monthYear = "DEC" & " " & Right(exp, 2) & " " End Select 'Call/Put designation If optionType = "CALL" Then GetMonthCode = monthYear & "Calls" ElseIf optionType = "PUT" Then GetMonthCode = monthYear & "Puts" End If End Function