Returning values from 1 sheet based on a single value in another

[rickf19]

Hi all

I have a spreadsheet of data that has 6 columns B,H,I,J,L which I want to pull all the rows that have a specific value in COL E

EG

B = Period
H = Date
I = Detail
J = Amount
L= Ref

E = Code

I want to create a number of Tabs that will pull out the data in each of the B to L columns based on the value in Col E
I could just filter the data sheet on the values in Col E and copy/paste to each tab, but the data sheet is updated regularly and there are approx 45 different codes to create sheets for.


Any help gratefully received
Rick

 

[kanadaaa]

Try this in a standard module:

Sub CreateSheets()
    Dim fnd As Range, tempFnd As Range, lr As Long, srcSh As Worksheet, desSh As Worksheet, i As Long
    Set srcSh = ActiveSheet
    With srcSh
        lr = .Range("E" & Rows.Count).End(xlUp).Row
        Set fnd = .Range("E1:E" & lr).Find("a") 'Change the argument of FIND to the value you look for
        If fnd Is Nothing Then
            MsgBox "No match found in column E", vbExclamation, "Error"
            Exit Sub
        End If
        Set tempFnd = fnd
        Application.ScreenUpdating = False
        Do While Not fnd Is Nothing
            i = i + 1
            Sheets.Add After:=Sheets(Sheets.Count)
            Set desSh = ActiveSheet
            desSh.Cells(1, "A") = .Cells(fnd.Row, "B")
            desSh.Cells(1, "B") = .Cells(fnd.Row, "H")
            desSh.Cells(1, "C") = .Cells(fnd.Row, "I")
            desSh.Cells(1, "D") = .Cells(fnd.Row, "J")
            desSh.Cells(1, "E") = .Cells(fnd.Row, "L")
            Set fnd = .Range("E1:E" & lr).FindNext(fnd)
            If fnd.Address = tempFnd.Address Then
                Exit Do
            End If
        Loop
        srcSh.Activate
        Application.ScreenUpdating = True
        MsgBox "Created " & i & " new worksheets"
    End With
End Sub

 

[rickf19]

Thanks
I have never used VBA so where/how do I insert the code and if I change the argument in line 6 will it create separate Tabs dependant on the value in there? can this value be related to the value in a cell eg A1 on each Tab is code no to look for transactions in data sheet.

Rick

 

[kanadaaa]

if I change the argument in line 6 will it create separate Tabs dependant on the value in there? can this value be related to the value in a cell eg A1

If you look for the value "Code" then modify the line to:

Set fnd = .Range("E1:E" & lr).Find("Code")

If you look for the value in cell A1 then modify the line to:

Set fnd = .Range("E1:E" & lr).Find(Range("A1"))

I have never used VBA so where/how do I insert the code

Do the following:
1. If your current workbook isn’t a macro-enabled workbook, save it as an .xlsm file (File > Save As)
2. If you don’t have the developer tab in the ribbon, turn it on (see Developer Tab in Excel)
3. Open the code tab (right-click on any sheet name)
4. Insert a module (in Insert)
5. Copy and paste the code into the module
6. Activate the sheet on which you have the dataset
7. Press macros on the developer tab and run the macro named CreateSheets

 

[rickf19]

Hi

managed to get it to run
However
created 162 Tabs with one line on each
I am looking for
Tab for code 1 (COL E) to show the 2 rows of data it has in the Data tab
Tab for Code 9 (COL E) to show the 5 rows of data it has in the Data Tab
Tab for Code 11 (COL E) to show the 1293 rows of data in the Data Tab
etc etc
depending on the source of the data Col E can have up to 6 digits (0500 and 0599 are text ie preceded by ')

The query re CELL a1 and changing the code was in relation to running something on each Tab with the required code in cell A1 being the lookup value

getting quite excited at learning thisnew stuff but must say looks pretty complicatedto create code.

Rick

 

[kanadaaa]

By “the Data tab”, do you mean a worksheet named “Data”? (“Tab”could cause unwanted confusion sometimes, I think.)
If so what does it look like? (An image would be best.)

I am looking for
Tab for code 1 (COL E) to show the 2 rows of data it has in the Data tab
Tab for Code 9 (COL E) to show the 5 rows of data it has in the Data Tab
Tab for Code 11 (COL E) to show the 1293 rows of data in the Data Tab
etc etc
depending on the source of the data Col E can have up to 6 digits (0500 and 0599 are text ie preceded by ')

What’s the systematic pattern between the code number and the number of rows?

 

[rickf19]

Hi
thanks for your patience

Data tab is source sheet which holds base data

What I am trying to do is create individual sheets for each code that is in column E code 2 and will show all the entries for that code eg. from data above would have a sheet for codes 1,5,9, 10A,11,12,16,17,20,21 each sheet showing each individual row of data in columns
B = Period
H = Date
I = Detail
J = Amount
L= Ref


Hope this helps

Can you tell me what you expected to be insert in this line of the code please
Set fnd = .Range("E1:E" & lr).Find("a") 'Change the argument of FIND to the value you look for

I changed "a" to 9 which gave the 160odd tabs

Thanks

Rick

 

[kanadaaa]

Data tab is source sheet which holds base data

What is the exact name of the sheet? "Data tab"?

Can you tell me what you expected to be insert in this line of the code please
Set fnd = .Range("E1:E" & lr).Find("a") 'Change the argument of FIND to the value you look for

Forget about that for now because that argument specification can be automated.

I changed "a" to 9 which gave the 160odd tabs

Please do not call worksheets "tabs" because it's confusing, as I told you above.

 

[rickf19]

Hi
Sheet ("Tab") is called Data
This is "bible" where transactions are copied from other sources and codes attached via a lookup to a code mapping sheet ("Tab") It is then used to create a number of pivots and some management reports.
The reason for the requirement for a sheet for each "code" in Col E is to create a ledger page for each code
Thanks
Rick

 

[kanadaaa]

The code below would do the trick you're needing:

Sub OutputDatasetBasedOnCode2()
    Dim d As Object, lr As Long
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
   
    With Sheets("Tab")
   
        'Get all codes in column E
        lr = .Cells(Rows.Count, "E").End(xlUp).Row
        For i = 5 To lr
            d.Item(.Cells(i, "E").Value) = "Code2"
        Next i
        Debug.Print "==========" & vbCrLf & "Codes:"
        For i = 0 To d.Count - 1
            Debug.Print d.keys()(i)
        Next i
       
        Dim ws As Worksheet, j As Long
       
        'Create sheets named after the codes
        Application.DisplayAlerts = False
        For i = 0 To d.Count - 1
            If SheetExists(CStr(d.keys()(i))) Then
                Sheets(CStr(d.keys()(i))).Delete
                Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
                ws.Name = d.keys()(i)
            Else
                Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
                ws.Name = d.keys()(i)
            End If
            For j = 1 To 5
                ws.Cells(1, j).Value = Choose(j, "Period", "Date", "Detail", "Amount", "Ref")
            Next j
        Next i
        Application.DisplayAlerts = True
       
        Dim fnd As Range, tempFnd As Range, lrForOutput As Long
       
        'Output values
        For i = 0 To d.Count - 1
            Set fnd = .Range("E4:E" & lr).Find(d.keys()(i))
            Set tempFnd = fnd
            Do While Not fnd Is Nothing
                lrForOutput = Sheets(CStr(d.keys()(i))).Cells(Rows.Count, "A").End(xlUp).Row + 1
                Sheets(CStr(d.keys()(i))).Cells(lrForOutput, "A") = .Cells(fnd.Row, "B")
                Sheets(CStr(d.keys()(i))).Cells(lrForOutput, "B") = .Cells(fnd.Row, "H")
                Sheets(CStr(d.keys()(i))).Cells(lrForOutput, "C") = .Cells(fnd.Row, "I")
                Sheets(CStr(d.keys()(i))).Cells(lrForOutput, "D") = .Cells(fnd.Row, "J")
                Sheets(CStr(d.keys()(i))).Cells(lrForOutput, "E") = .Cells(fnd.Row, "L")
                Set fnd = .Range("E4:E" & lr).FindNext(fnd)
                If fnd.Address = tempFnd.Address Then Exit Do
            Loop
        Next i

        .Activate
        Application.ScreenUpdating = True
        MsgBox "Dataset for the following codes have been exported:" & vbCrLf & vbCrLf & Join(d.keys, ", ")

    End With
End Sub

Function SheetExists(SheetName As String) As Boolean
    SheetExists = False
    For Each Sheet In Sheets
        If Sheet.Name = SheetName Then
            SheetExists = True
            Exit Function
        End If
    Next Sheet
End Function