Optimising Macro to auto add new sheets and rename based on a columns criteria but excluding one specific entry

Daddydodah

New Member
Joined
Sep 3, 2015
Messages
8
Hi! I am am looking for some much needed help but please bear with me as I am a complete novice and only joined Mrexcel today!

Using windows 7 with Excel 2013 but would like this to run on previous versions also.

The following is what I would ideally like:
I have a workbook with 2 worksheets: "Job Programming" and "Modifications". These are always to remain. Survey information is inputted into the "Job Programming" Sheet which has headers up to the first 5 rows and multiple columns. When rows are added by the user I would like a sheet to be automatically added (copying across the first 5 rows and all the headers from the "Job Programming" sheet and inserting any new sheets after the "Modifications" sheet) based on the column (column D) named "STYLE" and the inputs into this column. I would like the format of the cells/rows which are copied from the first sheet to stay the same as what is on the first sheet once the new sheet has been created. I would like when data is changed/added on the first sheet for the subsequent sheets to be updated/added/removed accordingly.

I currently have a workbook that I have created which is running some macros that kind of achieves the above. I have a command button on the first sheet which when clicked runs all of my macros (4 in total). They run in this order: The first macro deletes any created sheets (so the created sheets are always fresh when the button is clicked)> the next looks at the data in the "Job Programming" sheet and creates sheets based on the inputs of the "STYLE" column and copies across any corresponding rows onto those sheets > the next macro runs to clear any command buttons from the created sheets as when it copies across the first 5 rows onto the new sheets it also copies the command button across which I don't want > the last macro to run is to delete the created sheet called "STYLE" The problem is because I have separated my data on the first sheet with multiple header rows down the page it thinks there should be a sheet named "STYLE" and as I don't know how to exclude this input in the code I run a macro at the end to delete that created sheet. When the new sheets are created they do not retain the same formatting (conditional formatting/cell width etc) as the rows on the first sheet (funnily enough if the entry is taken from below the header rows then they do retain the formatting but if there are multiple entries then they do not. The column widths are never the same once).

I have no clue whether the code is inefficient or contains parts which might break in future and I really need an experts eye to either say this is fine or no its rubbish and if rubbish then how I should change it. My first thoughts are to try and get rid of the unnecessary macros but I really would appreciate any help on this!

(I would insert a pic of the first worksheet but I am unsure how - is there a way I can insert a pic from my desktop?)

The code is below:

PHP:
Sub DeleteSheets()

    Dim ws As Worksheet
    
    For Each ws In Worksheets
        If (ws.Name <> "Job Programming") And (ws.Name <> "Modifications") Then
            Application.DisplayAlerts = False
            Sheets(ws.Name).Delete
            Application.DisplayAlerts = True
        End If
    Next ws

col_to_new_sheetx
End Sub

Sub col_to_new_sheetx()

Const cl& = 4
Const ss As String = "Job Programming"  'name of start sheet

Dim a As Variant, x As Worksheet, sh As Worksheet
Dim rws&, cls&, p&, i&, rr&, j&
Dim b As Boolean

Sheets(ss).Activate
rws = Cells.Find("*", , , , xlByRows, xlPrevious).Row
cls = Cells.Find("*", , , , xlByColumns, xlPrevious).Column

Set x = Sheets.Add(After:=Sheets("Modifications"))
Sheets(ss).Cells(6, 1).Resize(rws, cls).Copy x.Cells(6, 1)
Set a = x.Cells(1).Resize(rws, cls)
a.Sort a(1, cl), 1, Header:=xlNo
a = a.Resize(rws + 5)
p = 1

For i = p To rws + 5
    If a(i, cl) <> a(p, cl) Then
        b = False
        For Each sh In Worksheets
            If sh.Name = a(p, cl) Then b = True: Exit For
        Next
        If Not b Then
            Sheets.Add.Name = a(p, cl)
            With Sheets(a(p, cl))
                x.Cells(1).Resize(1, cls).Copy .Cells(6, 1)
                ri = i - p
                x.Cells(p, 1).Resize(ri, cls).Cut .Cells(6, 1)
                Sheets(ss).Cells(1).Resize(5, cls).Copy .Cells(1)
            End With
        End If
        p = i
    End If
Next i

Application.DisplayAlerts = False
    x.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Clear_Buttons

End Sub

Sub Clear_Buttons()

    Dim ws As Worksheet
    
    For Each ws In Worksheets
        If (ws.Name <> "Job Programming") And (ws.Name <> "Modifications") Then
            Application.DisplayAlerts = False
            Sheets(ws.Name).Buttons.Delete
            Application.DisplayAlerts = True
        End If
    Next ws
Delete_Style
End Sub

Sub Delete_Style()
Dim ws As Worksheet
For Each ws In Worksheets
    If ws.Name = "STYLE" Then
        Application.DisplayAlerts = True
        Sheets("STYLE").Delete
        Application.DisplayAlerts = False
        End
    End If
Next

End Sub
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Forum statistics

Threads
1,215,039
Messages
6,122,802
Members
449,095
Latest member
m_smith_solihull

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