I have adapted this code written by Jerry Beucaire. Works well and perfectly suited to my needs.
I want to have a condition in the code that if Column "A" of "Data sheet" includes something specific or part thereof, that is doesn't add a the 2 template sheets (TskSheet, EstSheet) for that specific row.
Where in this code would I put the "Select Case" code so that a sheet will not be created if column "A" of the "Data sheet" includes the words "Header", "Total" or "Subtotal" or part thereof. it can NOT be case sensitive in case it is written in upper or lower case or combination of upper and lower. Or alternatively the other option is to add sheets if column "A" only includes "Bid Item" in the contents of the cell.
I am asking about "Select Case", as I had assistance from user Fluff on a similar issue and it was a great solution for what I needed.
I'm learning slowly
Sub BuildWorksheets()
'FillOutTemplate()
'Jerry Beaucaire 4/25/2010
'From Sheet1 data fill out template on sheet2 and save
'each sheet as its own file.
Dim LastRw As Long, Rw As Long, Cnt As Long
Dim dSht As Worksheet, tSht As Worksheet
Dim MakeBooks As Boolean, SavePath As String
Application.ScreenUpdating = False 'speed up macro execution
Application.DisplayAlerts = False 'no alerts, default answers used
Sheets("TskSheet").Visible = True
Sheets("EstSheet").Visible = True
Set dSht = Sheets("Data") 'sheet with data on it starting in row 2
Set tSht = Sheets("TskSheet") 'template sheet to copy and fill out to row 2
Set eSht = Sheets("EstSheet") 'template sheet to copy and fill out to row 2
'Option to create separate workbooks
MakeBooks = MsgBox("Create separate workbooks?" & vbLf & vbLf & _
"YES = template will be copied to separate workbooks." & vbLf & _
"NO = template will be copied to sheets within this same workbook", _
vbYesNo + vbQuestion) = vbYes
If MakeBooks Then 'select a folder for the new workbooks
MsgBox "Please select a destination for the new workbooks"
Do
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then 'a folder was chosen
SavePath = .SelectedItems(1) & "\"
Exit Do
Else 'a folder was not chosen
If MsgBox("Do you wish to abort?", _
vbYesNo + vbQuestion) = vbYes Then Exit Sub
End If
End With
Loop
End If
'Determine last row of data then loop through the rows one at a time
LastRw = dSht.Range("c" & Rows.Count).End(xlUp).Row
Dim shN As String
For Rw = 2 To LastRw 'Data that will fill templates starts on this row.
'copy the template
With ActiveSheet 'fill out the form
'edit these rows to fill out your form, add more as needed
Set ws = Nothing
On Error Resume Next
Set ws = Worksheets(CStr(dSht.Range("c" & Rw).Value))
On Error GoTo 0
If ws Is Nothing Then
eSht.Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = CStr(dSht.Range("c" & Rw).Value)
ActiveSheet.Range("a2").Value = dSht.Range("a" & Rw).Value
ActiveSheet.Range("b2").Value = dSht.Range("b" & Rw).Value
ActiveSheet.Range("c2").Value = dSht.Range("C" & Rw).Value
ActiveSheet.Range("d2").Value = dSht.Range("d" & Rw).Value
ActiveSheet.Range("e2").Value = dSht.Range("e" & Rw).Value
ActiveSheet.Range("f2").Value = dSht.Range("f" & Rw).Value
ActiveSheet.Range("g2").Value = dSht.Range("g" & Rw).Value
shN = ActiveSheet.Range("c2").Value
'ActiveSheet.Protect Password:="biff1972"
tSht.Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = shN & "(1)"
ActiveSheet.Range("a2").Value = dSht.Range("a" & Rw).Value
ActiveSheet.Range("b2").Value = dSht.Range("b" & Rw).Value
ActiveSheet.Range("c2").Value = dSht.Range("C" & Rw).Value
ActiveSheet.Range("d2").Value = dSht.Range("d" & Rw).Value
ActiveSheet.Range("e2").Value = dSht.Range("e" & Rw).Value
ActiveSheet.Range("f2").Value = dSht.Range("f" & Rw).Value
ActiveSheet.Range("g2").Value = dSht.Range("g" & Rw).Value
'ActiveSheet.Protect Password:="biff1972"
End If
End With
If MakeBooks Then 'if making separate workbooks from filled out form
ActiveSheet.Move
ActiveWorkbook.SaveAs SavePath & Range("d3").Value, xlNormal
ActiveWorkbook.Close False
End If
Cnt = Cnt + 1
Next Rw
dSht.Activate
If MakeBooks Then
MsgBox "Workbooks created: " & Cnt
Else
MsgBox "Worksheets created: " & Cnt
End If
Sheets("TskSheet").Visible = False
Sheets("EstSheet").Visible = False
Application.ScreenUpdating = True
End Sub
I want to have a condition in the code that if Column "A" of "Data sheet" includes something specific or part thereof, that is doesn't add a the 2 template sheets (TskSheet, EstSheet) for that specific row.
Where in this code would I put the "Select Case" code so that a sheet will not be created if column "A" of the "Data sheet" includes the words "Header", "Total" or "Subtotal" or part thereof. it can NOT be case sensitive in case it is written in upper or lower case or combination of upper and lower. Or alternatively the other option is to add sheets if column "A" only includes "Bid Item" in the contents of the cell.
I am asking about "Select Case", as I had assistance from user Fluff on a similar issue and it was a great solution for what I needed.
I'm learning slowly
VBA Code:
Sub BuildWorksheets()
'FillOutTemplate()
'Jerry Beaucaire 4/25/2010
'From Sheet1 data fill out template on sheet2 and save
'each sheet as its own file.
Dim LastRw As Long, Rw As Long, Cnt As Long
Dim dSht As Worksheet, tSht As Worksheet
Dim MakeBooks As Boolean, SavePath As String
Application.ScreenUpdating = False 'speed up macro execution
Application.DisplayAlerts = False 'no alerts, default answers used
Sheets("TskSheet").Visible = True
Sheets("EstSheet").Visible = True
Set dSht = Sheets("Data") 'sheet with data on it starting in row 2
Set tSht = Sheets("TskSheet") 'template sheet to copy and fill out to row 2
Set eSht = Sheets("EstSheet") 'template sheet to copy and fill out to row 2
'Option to create separate workbooks
MakeBooks = MsgBox("Create separate workbooks?" & vbLf & vbLf & _
"YES = template will be copied to separate workbooks." & vbLf & _
"NO = template will be copied to sheets within this same workbook", _
vbYesNo + vbQuestion) = vbYes
If MakeBooks Then 'select a folder for the new workbooks
MsgBox "Please select a destination for the new workbooks"
Do
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then 'a folder was chosen
SavePath = .SelectedItems(1) & "\"
Exit Do
Else 'a folder was not chosen
If MsgBox("Do you wish to abort?", _
vbYesNo + vbQuestion) = vbYes Then Exit Sub
End If
End With
Loop
End If
'Determine last row of data then loop through the rows one at a time
LastRw = dSht.Range("c" & Rows.Count).End(xlUp).Row
Dim shN As String
For Rw = 2 To LastRw 'Data that will fill templates starts on this row.
'copy the template
With ActiveSheet 'fill out the form
'edit these rows to fill out your form, add more as needed
Set ws = Nothing
On Error Resume Next
Set ws = Worksheets(CStr(dSht.Range("c" & Rw).Value))
On Error GoTo 0
If ws Is Nothing Then
eSht.Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = CStr(dSht.Range("c" & Rw).Value)
ActiveSheet.Range("a2").Value = dSht.Range("a" & Rw).Value
ActiveSheet.Range("b2").Value = dSht.Range("b" & Rw).Value
ActiveSheet.Range("c2").Value = dSht.Range("C" & Rw).Value
ActiveSheet.Range("d2").Value = dSht.Range("d" & Rw).Value
ActiveSheet.Range("e2").Value = dSht.Range("e" & Rw).Value
ActiveSheet.Range("f2").Value = dSht.Range("f" & Rw).Value
ActiveSheet.Range("g2").Value = dSht.Range("g" & Rw).Value
shN = ActiveSheet.Range("c2").Value
'ActiveSheet.Protect Password:="biff1972"
tSht.Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = shN & "(1)"
ActiveSheet.Range("a2").Value = dSht.Range("a" & Rw).Value
ActiveSheet.Range("b2").Value = dSht.Range("b" & Rw).Value
ActiveSheet.Range("c2").Value = dSht.Range("C" & Rw).Value
ActiveSheet.Range("d2").Value = dSht.Range("d" & Rw).Value
ActiveSheet.Range("e2").Value = dSht.Range("e" & Rw).Value
ActiveSheet.Range("f2").Value = dSht.Range("f" & Rw).Value
ActiveSheet.Range("g2").Value = dSht.Range("g" & Rw).Value
'ActiveSheet.Protect Password:="biff1972"
End If
End With
If MakeBooks Then 'if making separate workbooks from filled out form
ActiveSheet.Move
ActiveWorkbook.SaveAs SavePath & Range("d3").Value, xlNormal
ActiveWorkbook.Close False
End If
Cnt = Cnt + 1
Next Rw
dSht.Activate
If MakeBooks Then
MsgBox "Workbooks created: " & Cnt
Else
MsgBox "Worksheets created: " & Cnt
End If
Sheets("TskSheet").Visible = False
Sheets("EstSheet").Visible = False
Application.ScreenUpdating = True
End Sub