Help with creating mini worksheets from major workbook

Dan Wilson

Well-known Member
Joined
Feb 5, 2006
Messages
504
Office Version
  1. 365
Platform
  1. Windows
Good day. I have been asking for a lot of help over the last few days, but this should be the last one for a while. I am running Office 365 (updated) on Windows 10 Home. I have a workbook that will create a worksheet titled "DB" containing a list of almost 5,000 songs in my Music folder. The DB worksheet will contain 8 Columns of data with one of those columns being the Genre of each song. Once the DB has been created, I would like to create additional worksheets in the same workbook dedicated to each Genre of music. This process does not have to be part of the DB creation Macro. The new worksheet will look exactly like the DB with the same formatting and Column Width. What I need is a formula that will search each of the 5,000 entries and populate the new worksheet with just the songs that match the selected Genre. I am fairly good with Macros and hope that this can be resolved by creating a Macro for each Genre type. Once that is done, I can then combine all the Macros into one. Thank you for any help.
Dan Wilson...
 
HI Logit. I finally got XL2BB to install. There may still some problems with it. After I installed it the first time, then closed Excel and re-opened it, the MrExcel tab was gone. I reinstalled it and made the copies without closing and reopening Excel. From what I can see, it does not appear that the Capture Range function captures the Macros, so I will try the Dropbox approach. I included the Dropbox link below. I hope it works. I copied the entire workbook.


Thank you for sticking with this one. When you open the workbook, you will find 4 sheets, Home, DB, Test, and Oldies. There are 3 Macros in the Developer folder, create_separate_worksheet, get_file_properties_DB and get_file_properties_test. The Home sheet was included when I dowloaded the working file to create the DB worksheet. By executing the get_file_properties_DB Macro, the macro creates the DB worksheet. By executing the get_file_properties_test, it does the same thing but limits itself to a secondary music folder containing less than 25 songs. I use that for testing. Creating the DB worksheet takes about 5 minutes (5,000 song files). The create_separate_worksheet is the macro that you sent to me. The Oldies worksheet contains a sample of the songs in the Oldies Genre. I did not copy all of the Genre to save space. The Music folder is 12 GB in size, all the files are in MP3 format, and I didn't see why you would need that as long as you have the DB worksheet. I can't think of anything else that you might need. Let me know if there is something I missed. Also excuse the delay in getting back to you. I had terrible time trying to install the XL2BB app. Thank you, Dan Wilson...
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
.
Either use the download workbook or, with your existing workbook there, delete all sheets currently having a name of one of the MUSIC GENRES. The macro
will error if there already exists a sheet by the same name as one of the genres.

Here is the macro:

VBA Code:
Option Explicit

Sub CreateNewTabsWithHeaders()
Dim Cl As Range
Dim Ws As Worksheet
Dim Ky As Variant

Set Ws = Sheets("DB")
Application.ScreenUpdating = False

With CreateObject("scripting.dictionary")

    For Each Cl In Ws.Range("G2", Ws.Range("G" & Rows.Count).End(xlUp))
        .Item(Cl.Value) = Empty
    Next Cl
    
    For Each Ky In .Keys
        Ws.Range("A1:G1").AutoFilter 7, Ky
        Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
        Ws.AutoFilter.Range.SpecialCells(xlVisible).EntireRow.Copy Range("A1")
    Next Ky
    
    Ws.AutoFilterMode = False
    
End With
Application.ScreenUpdating = True
End Sub

The download example functions as desired. Music Database.xlsm
 
Upvote 0
WOW!!! Absolutely amazing! I read the Macro and understood some of it, but did not expect the results that it created. In order to format the newly created worksheets and choose which Genres to search, is it possible to adjust the Macro to find and create a single Genre by choice? My music show will be limited to a few Genres. That way I can then add statements to the Macro for cell formatting, column width, and bordering. If I have one Macro to choose a specific Genre, then I can edit the Genre, save the new Macro and at some point create a Macro that will combine the hosen Macros into one. If that is not easy to do, I will work with what you gave me. Thank you again for sticking with me on this one. I will create a new post for help with XL2BB. The MrExcel function just does not want to stay installed
 
Upvote 0
Good day Pater_SSs. Thank you for helping with the XL2BB problem. After finally reading your instruction to click on the Properties of the XL2BB file inside the Add-ins folder, all is well. I spent a while trying to find an Add-ins folder in File Explorer. Once I found it, I tried to find the Unblock option, but it was in the XL2BB file.
Dan Wilson...
 
Upvote 0
Good day Logit. I truly appreciate what you did for me. Perhaps I offended you by asking you to adjust the Macro to find one Genre. Obviously, your Excel expertise is way beyond my comprehension. Thank you, Dan Wilson...

Edited by Moderator
 
Last edited by a moderator:
Upvote 0
Assuming ..
  1. The data in the main sheet is a formal table as I described in post #4
  2. If you want to create a sheet for a single Genre and a sheet with that genre as a name already exists then that sheet can be deleted
.. test this Worksheet_BeforeDoubleClick event code with a copy of your workbook. To implement ..
1. Right click the main sheet's name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1. (Check/edit the Genre column heading in the code if required)
3. Close the Visual Basic window & test.
4. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim wsDB As Worksheet
  Dim sGenre As String
  
  If Not Intersect(Target, ActiveSheet.ListObjects(1).ListColumns("Genre").Range) Is Nothing Then '<- Check column heading
    If Len(Target.Value) > 0 Then
      Set wsDB = ActiveSheet
      sGenre = Target.Value
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      On Error Resume Next
      Sheets(sGenre).Delete
      On Error GoTo 0
      Application.DisplayAlerts = True
      wsDB.Copy After:=ActiveSheet
      With Sheets(wsDB.Index + 1).ListObjects(1)
        .Parent.Name = sGenre
        .AutoFilter.ShowAllData
        .Range.AutoFilter Field:=.ListColumns("Genre").Index, Criteria1:="<>" & sGenre  '<- Check column heading
        .Range.Offset(1).EntireRow.Delete
        .AutoFilter.ShowAllData
      End With
      Application.ScreenUpdating = True
    End If
  End If
End Sub
 
Upvote 0
I would like to create additional worksheets in the same workbook dedicated to each Genre of music.
The new worksheet will look exactly like the DB with the same formatting and Column Width.

Hi,
Try following & see if it does what you want

Place code in a STANDARD module. (Alt+F11 takes you to VBA Editor) then from menu (INSERT > MODULE )

VBA Code:
Option Explicit
Sub FilterData()
'DMT32 updated June 2020
    Dim ws1Master As Worksheet, wsName As Worksheet, wsFilter As Worksheet
    Dim Datarng As Range, FilterRange As Range, objRange As Range
    Dim rowcount As Long, FilterRow As Long, colcount As Long, FilterCol As Long
    Dim SheetName As String, msg As String
    
    
'master sheet
    Set ws1Master = ActiveSheet
    
'select the Column filtering
top:
    On Error Resume Next
    Set objRange = Application.InputBox("Select Field Name To Filter", "Range Input", , , , , , 8)
    On Error GoTo progend
    If objRange Is Nothing Then
        Exit Sub
    ElseIf objRange.Columns.Count > 1 Then
        GoTo top
    End If
    
    FilterCol = objRange.Column
    FilterRow = objRange.Row
    
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
    
'add filter sheet
    Set wsFilter = Sheets.Add
    
    With ws1Master
        .Activate
'add password if needed
        .Unprotect Password:=""
        
        rowcount = .Cells(.Rows.Count, FilterCol).End(xlUp).Row
        colcount = .Cells(FilterRow, .Columns.Count).End(xlToLeft).Column
        
        If FilterCol > colcount Then
            Err.Raise 65000, "", "FilterCol Setting Is Outside Data Range.", "", 0
        End If
        
        Set Datarng = .Range(.Cells(FilterRow, 1), .Cells(rowcount, colcount))
        
'extract Unique values from selected column
        .Range(.Cells(FilterRow, FilterCol), .Cells(rowcount, FilterCol)).AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=wsFilter.Range("A1"), Unique:=True
        
        rowcount = wsFilter.Cells(wsFilter.Rows.Count, "A").End(xlUp).Row
        
'apply criteria field heading
        wsFilter.Range("B1").Value = wsFilter.Range("A1").Value
        
        For Each FilterRange In wsFilter.Range("A2:A" & rowcount)
            
'check for blank cell in range
            If Len(FilterRange.Value) > 0 Then
                
'add the FilterRange to criteria

'create criteria for exact match
                wsFilter.Range("B2").Formula = "=" & """=" & FilterRange.Value & """"
                
'ensure tab name limit not exceeded
                SheetName = Trim(Left(FilterRange.Value, 31))
                
'check if sheet exists
                If Not Evaluate("ISREF('" & SheetName & "'!A1)") Then
'add new sheet
                    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
                End If
'set wsname object variable
                    Set wsName = Worksheets(SheetName)
'clear existing data
                    wsName.UsedRange.ClearContents

'apply filter
                Datarng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsFilter.Range("B1:B2"), _
                CopyToRange:=wsName.Range("A1"), Unique:=False
                
            End If
'size column widths to match master
'NB - slows code down a little
            Datarng.Rows(1).Copy
            wsName.UsedRange.Rows(1).PasteSpecial xlPasteColumnWidths
            Set wsName = Nothing
'clear clipboard
            Application.CutCopyMode = False
        Next
        
        .Select
    End With
    
    
progend:
    wsFilter.Delete
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True
    End With
    
    If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

When run, an InputBox will appear - select with mouse Field Name you want to filter (Genre) & press ok.

Code should copy all records (and column widths) for each selected field (genre) to a sheet with same name & if sheet does not exist, code will create one with that name.

When you update master list & run code, old data is cleared from existing sheets before records are copied to them.


Hope Helpful

Dave
 

Attachments

  • Filter Example.jpg
    Filter Example.jpg
    178.8 KB · Views: 9
Upvote 0
OK, I give up. Either no-one is reading what I write, or I am not writing what I want in a way that can be understood. I have tried all the Macros provided by Logit, Peter_SSs and dmt32. I have tried copying the DB workbook to a new version and deleting all the Macros except the one to be tested thinking that maybe they were all running even though only one was chosen. Every one of the Macros returns 32 new worksheets, one for each Genre. All I want is a Macro to search the DB worksheet looking for a match to a single Genre and then populate a new worksheet with the results of that search. I find it difficult to believe that cannot be done. I know nothing about Tables and I don’t understand most of the code in the Macros that I have been given. I thought I was doing well with Excel and Macros. I have re-evaluated myself back to beginner level after seeing some of the code in the Macros provided. If my request to search the DB worksheet for a particular Genre cannot be done, please let me know and I will resort to doing a manual sort of the Genre Column in the DB worksheet, then copy and past the matching Rows into a new worksheet. I genuinely appreciate the help that has been given, but it is over my head. I wish I knew half as much as the three of you have shown me. Thank you and I hope there is an answer out there somewhere that will work for me.
 
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,337
Members
448,568
Latest member
Honeymonster123

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