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

rickf19

Board Regular
Joined
Aug 30, 2019
Messages
66
Office Version
  1. 2016
Platform
  1. Windows
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
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Found the culprit..
Capture4.PNG
Capture5.PNG


Will debug this ASAP. Give me some time.
 

Attachments

  • Capture5.PNG
    Capture5.PNG
    75.8 KB · Views: 2
Upvote 0
Hi
if its easier just change the cap A to a small one on the data sheet as it is the same code just entered wrongly elsewhere and picked up as different.

Rick
 
Upvote 0
Hi, try the code below by replacing it for the whole of my older code.
Note: This code first deletes sheets whose names contain "Sheet", so if you currently have any sheet whose name contains "Sheet" and if you don't want it to be deleted, rename it as something not involving "Sheet", before running this macro.
VBA Code:
Sub OutputDatasetBasedOnCode2()
    Dim d As Object, lr As Long
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
  
    With Sheets("Data")
  
        '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, fnd As Range, tempFnd As Range, lrForOutput As Long
        Call RemoveOlderSheets
      
        'Create sheets and output values
        For i = 0 To d.Count - 1
            Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
            ws.Cells(1, 1).Value = "Code2 ="
            ws.Cells(1, 2).Value = d.keys()(i)
            For j = 1 To 5
                ws.Cells(2, j).Value = Choose(j, "Period", "Date", "Detail", "Amount", "Ref")
            Next j
            Set fnd = .Range("E4:E" & lr).Find(d.keys()(i))
            Set tempFnd = fnd
            Do While Not fnd Is Nothing
                lrForOutput = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
                ws.Cells(lrForOutput, "A") = .Cells(fnd.Row, "B")
                ws.Cells(lrForOutput, "B") = .Cells(fnd.Row, "H")
                ws.Cells(lrForOutput, "C") = .Cells(fnd.Row, "I")
                ws.Cells(lrForOutput, "D") = .Cells(fnd.Row, "J")
                ws.Cells(lrForOutput, "E") = .Cells(fnd.Row, "L")
                ws.Columns("A:E").AutoFit
                ws.Columns("D:D").NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                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

Sub RemoveOlderSheets()
    For Each Sheet In Sheets
        If InStr(Sheet.Name, "Sheet") > 0 Then
            Application.DisplayAlerts = False
            Sheet.Delete
            Application.DisplayAlerts = True
        End If
    Next Sheet
End Sub
 
Upvote 0
Hi

That ran and produced sheets 1 to sheet 63
Data looks fine I just need to format the date column, label the sheets and re order them
As this will be used on an ongoing basis ie data being added, checked and saved as next month each month, do I just rerun the macro whenever the data tab is updated with more info or changed ie current data changed ?

Thanks very much for all your time

Rick
 
Upvote 0
Just noticed Sheet 5, code 2 = 5 ,is picking up all data with a 5 in the code, ie 5 4500 4510 4520 7500
seems to be the same with the other sheets

Rick
 
Upvote 0
Updates:
VBA Code:
Sub OutputDatasetBasedOnCode2()
    Dim d As Object, lr As Long
    Set d = CreateObject("Scripting.Dictionary")
    Application.StatusBar = "Please wait..."
    Application.ScreenUpdating = False
 
    With Sheets("Data")
 
        '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
       
        'Remove older sheets
        For Each Sheet In Sheets
            If InStr(Sheet.Name, "Sheet") > 0 Then
                Application.DisplayAlerts = False
                Sheet.Delete
                Application.DisplayAlerts = True
            End If
        Next Sheet
     
        Dim ws As Worksheet, j As Long, fnd As Range, tempFnd As Range, lrForOutput As Long
     
        'Create sheets and output values
        For i = 0 To d.Count - 1
            Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
            ws.Cells(1, 1).Value = "Code2 ="
            ws.Cells(1, 2).Value = "'" & d.keys()(i)
            For j = 1 To 5
                ws.Cells(2, j).Value = Choose(j, "Period", "Date", "Detail", "Amount", "Ref")
            Next j
            Set fnd = .Range("E4:E" & lr).Find(d.keys()(i), , xlValues, xlWhole)
            Set tempFnd = fnd
            Do While Not fnd Is Nothing
                lrForOutput = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
                ws.Cells(lrForOutput, "A") = .Cells(fnd.Row, "B")
                ws.Cells(lrForOutput, "B") = .Cells(fnd.Row, "H")
                ws.Cells(lrForOutput, "C") = .Cells(fnd.Row, "I")
                ws.Cells(lrForOutput, "D") = .Cells(fnd.Row, "J")
                ws.Cells(lrForOutput, "E") = .Cells(fnd.Row, "L")
                Set fnd = .Range("E4:E" & lr).FindNext(fnd)
                If fnd.Address = tempFnd.Address Then Exit Do
            Loop
            ws.Columns("A:E").AutoFit
            ws.Columns("B:B").NumberFormat = "dd/mm/yyyy"
            ws.Columns("D:D").NumberFormat = "#,##0.00_ ;[Red]-#,##0.00"
        Next i

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

    End With
End Sub

Sub SearchCode()
    Dim searchTar As String
    searchTar = "'" & Application.InputBox("Type the code to search for", "Search", Type:=2)
    For Each Sheet In Sheets
        With Sheet
            If .Cells(1, "B").PrefixCharacter & .Cells(1, "B").Value = searchTar Then
                .Activate
                Exit Sub
            End If
        End With
    Next Sheet
    MsgBox "No match found"
End Sub
I just need to format the date column
Just noticed Sheet 5, code 2 = 5 ,is picking up all data with a 5 in the code, ie 5 4500 4510 4520 7500
These have been debugged in the code above.
label the sheets
I chose not to do it because of the reason mentioned in #32.
If you need this function, open a new thread, mentioning the following:
============
Code2 has strings such as 10a and 10A, so it's not possible to simply name sheets after these because Excel doesn't distinguish letter cases in sheet names. So:
VBA Code:
Sub CreateSheets()
    Dim ws As Worksheet

    Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
    ws.Name = "10a"
    Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
    ws.Name = "10A" '<=Error at this line because of the duplicate sheet name
   
End Sub
If there's a workaround for this, I'd like it to be incorporated into this code: *my code*
But the guy who wrote this code has warned me that *my code* won't be compatible with this labelling function unless the following lines are modified, because sheet names won't involve "Sheet" any longer with this function added:
VBA Code:
        'Remove older sheets
        For Each Sheet In Sheets
            If InStr(Sheet.Name, "Sheet") > 0 Then 'If sheet name doesn't involve "Sheet" (thus not created previously by the macro), remove the sheet
                Application.DisplayAlerts = False
                Sheet.Delete
                Application.DisplayAlerts = True
            End If
        Next Sheet
============
Also, this makes it sounds like you understand VBA codes very well, so I suggest you tell people that you don't really.
re order them
I think we'd need another long code if we seek this function.
I've got you a workaround for this in the code above:
Run the macro named "SearchCode" and type in the code you're looking for.
Then the worksheet for the code will be shown.
If you still need the function to re-order sheets based on code names, I suggest you open a new thread, mentioning the following:
============
*My code* creates sheets for every code in column E and each code is displayed on cell B1.
I'd like a macro that re-orders these sheets based on the codes.
============
As this will be used on an ongoing basis ie data being added, checked and saved as next month each month, do I just rerun the macro whenever the data tab is updated with more info or changed ie current data changed ?
To make it concise, yes.
You could automate even that but it takes some time for the macro itself to run, so I don't recommend automating it.
 
Upvote 0
Solution
Hi

Thanks again for your patience and understanding.
The help you have given is great and will really help with this process.
I have certainly learnt a lot , but still a bit scared of the vba code thing, thank goodness for knowledgeable people like you who are prepared to share.

The code worked fine, haven't tried the Search code yet but sure it will work
As I said the plan is to use this to update every month by saving the spreadsheet in a monthly folder and then save as with the following months no. in the new months folder and update the data sheet with the data for that month. I am hoping that it will just be a case of rerunning the macro and it will update the current sheets created by the previous macro run , or do I have to delete the previous months macro sheets before running again. Any other problems you may foresee with this process ?

Thanks again its really appreciated

Rick
 
Upvote 0
I am hoping that it will just be a case of rerunning the macro and it will update the current sheets created by the previous macro run , or do I have to delete the previous months macro sheets before running again.
For example, say you have codes 1, 2, 3 this month and run the macro.
That gets you 3 new sheets for each code.
If you re-run the macro again next month with codes 1 and 2 only, don't worry, you'll only get 2 new sheets with any updates on Data sheet reflected on the sheets.

The thing is, you don't need to delete sheets created by the macro manually.
But note that the macro detects all sheets whose names contain "Sheet".
When you get to add new sheets manually in the future, don't forget to rename them so that their names don't have any string involving "sheet" before running the macro again, otherwise they will be removed.

As for the labelling and sorting functions, I think I'll try to write codes for them when I have some time later.
I can't tell if you're going to open new threads but if you are and if I manage to write codes for them you might see me again on those threads.
If not, I might show up on this thread later again, so keep an eye on it :)
 
Upvote 0
Thanks for that
Data each month will have the same codes just different number of rows added for those codes that have transactions in that month, so if I save Accounts Template Jan once complete and then "save as" Accounts Template Feb, update Feb Data sheet with transactions for Feb will the macro add the new data to the sheets created by the Jan macro ? or does it overwrite the existing sheets with everything from the data sheet ?. Either one is ok for me just want to ensure I am understanding the way this will work .

Rick
 
Upvote 0

Forum statistics

Threads
1,213,486
Messages
6,113,932
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top