How do I create new sheets from list & still do other things (VBA)

[excelgeekgirl]

Hi,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I've built a spreadsheet that calculates the volatility of stocks using a lot of different code & tricks that I've found online. Unfortunately, I've maxed out my knowledge of vba and am stuck. The script currently creates a new tab for each ticker symbol in column B and populates each tab with historical stock prices for the date range defined in column F (start date) & G (end date). This is great, unless I have duplicate tickers. I added a column (column A) and named it Tab, thinking I could define the tab names before running the script to accommodate duplicate tickers, however, I don't know how to edit the script so it names each tab using the list in column A and still populates the stock data.<o></o>
<o></o>
Any help would be greatly appreciated!!<o></o>

Sub Get_Yahoo()
    
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim Cell As Range
    Dim lst As Long
    Dim Ticker As String
    Dim StartDate As Date
    Dim EndDate As Date
    Dim a, b, c, d, e, f
    Dim StrURL As String
    Set Sh = Worksheets("Input")
    Set Rng = Sh.Range("b6:b" & Sh.Range("b65536").End(xlUp).Row)
    For Each Cell In Rng
        Ticker = Cell.Value
        StartDate = Cell.Offset(0, 4).Value
        EndDate = Cell.Offset(0, 5).Value
        a = Format(Month(StartDate) - 1, "00") '   Month minus 1
        b = Day(StartDate)
        c = Year(StartDate)
        d = Format(Month(EndDate) - 1, "00")
        e = Day(EndDate)
        f = Year(EndDate)
        StrURL = "URL;http://table.finance.yahoo.com/table.csv?"
        StrURL = StrURL & "s=" & Ticker & "&a=" & a & "&b=" & b
        StrURL = StrURL & "&c=" & c & "&d=" & d & "&e=" & e
        StrURL = StrURL & "&f=" & f & "&g=d&ignore=.csv"
        If WorksheetExists(Ticker, ActiveWorkbook) Then
            Application.DisplayAlerts = False
            Sheets(Ticker).Select
            ActiveWindow.SelectedSheets.Delete
            ActiveWorkbook.Worksheets.Add.Name = Ticker
        Else
            ActiveWorkbook.Worksheets.Add.Name = Ticker
        End If
        With ActiveSheet.QueryTables.Add(Connection:=StrURL, Destination:=Range("a3"))
           .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlAllTables
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .Refresh BackgroundQuery:=False
        End With
        Columns("A:A").TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 4), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1))
        
      
        
          Column_H_H = Range("G" & Rows.Count).End(xlUp).Row - 1
          Range("H4").Formula = "=RC[-1]/R[1]C[-1]-1"
          Range("H4").AutoFill Destination:=Range("h4:h" & Column_H_H), Type:=xlFillSeries
        
          Column_i_i = Range("g" & Rows.Count).End(xlUp).Row - 1
          Range("i4").Formula = "=IF(R[1]C[-2]<0.0000001,no data,LN(RC[-2]/R[1]C[-2]))"
          Range("i4").AutoFill Destination:=Range("i4:i" & Column_i_i), Type:=xlFillSeries
              
        
        Range("i1").Select
        ActiveCell.FormulaR1C1 = "=SQRT(VARP(R4C9:R[6699]C)*252)"
        Range("i1").Select
               
        Range("h3").Select
        ActiveCell.FormulaR1C1 = "Return"
        Range("h3").Select
        Range("i3").Select
        ActiveCell.FormulaR1C1 = "Natural Log"
        Range("i3").Select
        
                      
        Range("A4").Select
        Range(Selection, Selection.End(xlDown)).NumberFormat = "mm/dd/yy"
        
        Range("b4:e4").Select
        Range(Selection, Selection.End(xlDown)).NumberFormat = "0.00"
        
        Range("g4").Select
        Range(Selection, Selection.End(xlDown)).NumberFormat = "0.00"
        
        Range("i1").Select
        Range(Selection, Selection.End(xlDown)).NumberFormat = "0.0000"
        
        Range("h4:i4").Select
        Range(Selection, Selection.End(xlDown)).NumberFormat = "0.0000"
        
        
        Range("A3").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Font.Bold = True
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Range("A3").Select
        
        
        Columns("A:i").EntireColumn.AutoFit
    Next Cell
    
          
    Sheets("Input").Select
    Sheets("Input").Move Before:=Sheets(1)
    
End Sub

Function WorksheetExists(SheetName As String, _
Optional WhichBook As Workbook) As Boolean
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function