save excel files based on the cell value


Hello Everyone,

I am new to the forum and looking forward to get some help on the excel question I have.

I have a file with 6 sheets on it. 5 worksheets are named with account codes (ABC, DEF, GHI, JKL, MNO) and 1 is a summary worksheet with the above account codes as columns and department code as row. The department codes are 123, 456, 789, 101112, 131415 and so on up to 50 departments.

The department codes are standard. Each worksheet (account codes) may have all 50 departments or less. For example Department code 123 may appear in all account codes worksheets or may appear only in ABC, JKL and not on the rest. 

I have a macro click button (I dont have a macro yet) in sheet 1 with each department code listed on it. If I click button 123 (department code), I want macro to save the file with department: "123" and keep all 6 (summary and account codes) worksheets in the file with only data belonging to the department 123. 

If department 123 is having data only in ABC and JKL, i want macro to save the file with summary sheet, ABC sheet and JKL sheet (since other worksheets are not having data belonging to department 123)

Is this something possible? or is there any better ay to do this, if not by using buttons? 

Thanks for all the help. I am attaching a sample file




Here are two macros to get you started:

Sub show_deps()

sheet_count = ActiveWorkbook.Worksheets.Count

'loop through the worksheets in the workbook
For a = 1 To sheet_count

    If Sheets(a).Name <> "Summary" And Sheets(a).Name <> "Macros" Then

        Sheets(a).Range("A4").AutoFilter Field:=1, Criteria1:="123"

        Call RemoveHiddenRows

    End If

Next a

End Sub
Sub RemoveHiddenRows()
    Dim oRow As Range, rng As Range
    Dim myRows As Range
    With ActiveSheet
        Set myRows = Intersect(.Range("A:A").EntireRow, .UsedRange)
        If myRows Is Nothing Then Exit Sub
    End With

    For Each oRow In myRows.Columns(1).Cells
        If oRow.EntireRow.Hidden Then
            If rng Is Nothing Then
                Set rng = oRow
                Set rng = Union(rng, oRow)
            End If
        End If

    If Not rng Is Nothing Then rng.EntireRow.Delete
End Sub

You will need to do some tweaking but it should give you a big head-start on getting the project finished.

You will also need to add a macro that saves the spreadsheet as a new file but thats pretty easy and you should focus on that part after you get the above macros to work correctly.

The second macro was found online and seems to work OK but test it out on your data and see how it goes.

NOTE: run this on test files first since the second macro actually deletes the rows you don't want to see. 


Answer the Question

You must create an account to use the forum. Create an Account or Login