Creat a New Sheet with data filtered from another sheet

[chiswickbridge]

I have a stock market data set, in a worksheet named EntryBook.

The range used is from AA11 to AZ5010. ( say 5,000 transactions in a Financial Year )

Row 10 is for the header.

And a second worksheet named Watchlist, which has about 100 stock symbols from A1 to A100

I need a VBA to search one symbol name from "Watchlist" Say A1 cell and look at the corresponding value in Column AE in "Entry book".

Then it must create a new Worksheet, with the symbol name, and get all data from the row where the search matches..

For example, JSWSTE, appears in rows 111, 114, 119, 120, 121 and so on.

So, I will have a new sheet named JSWSTE, and will must have the same header as Entrybook, and data from rows 111, 114, 119, 120, 121 and so on will follow.

This will help me in analyse the data...

Now I am doing the Filter way...

 

[John_w]

This could be done by AutoFiltering each different symbol, however I decided to use the FILTER function which requires less code.

Public Sub Filter_Symbols_To_New_Sheets()

    Dim dataRange As Range
    Dim watchList As Range
    Dim symbol As Range
    Dim symbolWs As Worksheet
    
    With Worksheets("EntryBook")
        Set dataRange = .Range("AA10", .Cells(.Rows.Count, "AZ").End(xlUp))
    End With
    
    With Worksheets("Watchlist")
        Set watchList = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
    End With
    
    For Each symbol In watchList
    
        Set symbolWs = Nothing
        On Error Resume Next
        Set symbolWs = Worksheets(symbol.Value)
        On Error GoTo 0
        If symbolWs Is Nothing Then
            Set symbolWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            symbolWs.Name = symbol.Value
        Else
            symbolWs.Cells.Clear
        End If
        
        symbolWs.Range("A1").Formula2 = "='" & dataRange.Worksheet.Name & "'!" & dataRange.Resize(1).Address
        symbolWs.Range("A2").Formula2 = "=FILTER('" & dataRange.Worksheet.Name & "'!" & dataRange.Address & ",'" & dataRange.Worksheet.Name & "'!" & dataRange.Offset(, 4).Resize(, 1).Address & "=""" & symbol.Value & """)"
    
    Next
    
End Sub

 

[kevin9999]

With this option, you select the stock of interest in the Watchlist sheet, then the code will create one sheet that matches that stock.

Option Explicit
Sub Get_Stocks()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Set ws1 = Worksheets("EntryBook")
    Set ws2 = Worksheets("Watchlist")
    
    If Not ws2 Is ActiveSheet Or ActiveCell.Column <> 1 Then
        MsgBox "You need to select a stock from column A of the Watchlist sheet first"
        Exit Sub
    End If
    
    Dim s As String
    s = ActiveCell.Value
    If Len(s) = 0 Then Exit Sub
    
    If MsgBox("Create a new sheet for " & s & " data?", vbYesNo, "Are You Sure?") = vbNo Then Exit Sub
    Set ws3 = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    ws3.Name = s
    
    If ws1.AutoFilterMode Then ws1.AutoFilter.ShowAllData
    With ws1.Range("AA10:AZ5010")
        .AutoFilter 5, s
        .Copy ws3.Range("A1")
    End With
    ws1.AutoFilter.ShowAllData
    ws3.Columns("A:Z").AutoFit
End Sub