eit09
Civil/Environmental
- Jul 8, 2009
- 183
I am trying to create a template that once a few cells are filled in the user can run a macro and auto populate specific named sheets to enter specific info.
To use this spreadsheet the user is required to enter specifics (Series/Chute#) in Cells A2&B2,A3&B3.... within the summary sheet then Select the CREATE SHEETS macro button. From there the user goes into each sheet created and enter the values in Cells D-F and those values then transfer back to the summary sheet.
I have 3 main issues I am looking for help not sure if I can fix this within the macro or a special formatting function.
1.On the summary sheet I tried locking the cells for columns C-F to avoid the users entering information directly, but when I run the macro with protected sheet it just transfers everything from the summary sheet to each auto created sheet. Works when the workbook is unprotected, but hoping there is a way to keep the cells with formulas on the summary sheet locked.
2. When the macro creates the new sheets it also copy's over the Macro button and the highlighting format of columns A&B.Is there a way to stop the macro button and highlighting from Columns A&B from coping over to the new sheets?
3. After running this macro if a few more series to the summary sheet were added is there an easy way to run the macro again, but code it to say ignore all sheets that have been created already and only create new sheets for the additional added series?
Below is the current VBA im using and attached is the file if what I have summarized above doesn't make sense.
Dim xRCount As Long
Dim xSht As Worksheet
Dim xNSht As Worksheet
Dim I As Long
Dim xTRrow As Integer
Dim xCol As New Collection
Dim xTitle As String
Dim xSUpdate As Boolean
Set xSht = ActiveSheet
On Error Resume Next
xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
xTitle = "A1:C1"
xTRrow = xSht.Range(xTitle).Cells(1).Row
For I = 2 To xRCount
Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text)
Next
xSUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCol.Count
Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
Set xNSht = Nothing
Set xNSht = Worksheets(CStr(xCol.Item(I)))
If xNSht Is Nothing Then
Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
xNSht.Name = CStr(xCol.Item(I))
Else
xNSht.Move , Sheets(Sheets.Count)
End If
xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
xNSht.Columns.AutoFit
Next
xSht.AutoFilterMode = False
xSht.Activate
Application.ScreenUpdating = xSUpdate
End Sub
To use this spreadsheet the user is required to enter specifics (Series/Chute#) in Cells A2&B2,A3&B3.... within the summary sheet then Select the CREATE SHEETS macro button. From there the user goes into each sheet created and enter the values in Cells D-F and those values then transfer back to the summary sheet.
I have 3 main issues I am looking for help not sure if I can fix this within the macro or a special formatting function.
1.On the summary sheet I tried locking the cells for columns C-F to avoid the users entering information directly, but when I run the macro with protected sheet it just transfers everything from the summary sheet to each auto created sheet. Works when the workbook is unprotected, but hoping there is a way to keep the cells with formulas on the summary sheet locked.
2. When the macro creates the new sheets it also copy's over the Macro button and the highlighting format of columns A&B.Is there a way to stop the macro button and highlighting from Columns A&B from coping over to the new sheets?
3. After running this macro if a few more series to the summary sheet were added is there an easy way to run the macro again, but code it to say ignore all sheets that have been created already and only create new sheets for the additional added series?
Below is the current VBA im using and attached is the file if what I have summarized above doesn't make sense.
Dim xRCount As Long
Dim xSht As Worksheet
Dim xNSht As Worksheet
Dim I As Long
Dim xTRrow As Integer
Dim xCol As New Collection
Dim xTitle As String
Dim xSUpdate As Boolean
Set xSht = ActiveSheet
On Error Resume Next
xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
xTitle = "A1:C1"
xTRrow = xSht.Range(xTitle).Cells(1).Row
For I = 2 To xRCount
Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text)
Next
xSUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCol.Count
Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
Set xNSht = Nothing
Set xNSht = Worksheets(CStr(xCol.Item(I)))
If xNSht Is Nothing Then
Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
xNSht.Name = CStr(xCol.Item(I))
Else
xNSht.Move , Sheets(Sheets.Count)
End If
xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
xNSht.Columns.AutoFit
Next
xSht.AutoFilterMode = False
xSht.Activate
Application.ScreenUpdating = xSUpdate
End Sub