Creating a new tab and filling in one column based on user responses

**goosetopher** · 02-25-2013, 07:49 PM

Hello!

I have a spreadsheet (attached) that has a "Project Build" tab and a "Template" tab. The "Project Build" tab has a list of typical project tasks in Column B, and a series of Check Boxes in Column A (beginning with Check Box 1). I would like to have a macro that will create a new tab (which is a copy of the "Template" tab) with the Project Number as the name, list the project tasks in Column E that were indicated by the user checking a box, and change Column N to "In Progress" for each row that has a task on the new sheet.

If possible, I would also like the project to get listed in the "Project Directory" tab and then have the "Project Build" tab reset after the macro has been run (I will use a command button to run the Macro).

Thank you very much for any help!
New Project Build.xlsm

**mike7952** · 02-25-2013, 09:26 PM

Heres a good start for you. You will need to get rid of all the extra checkboxes you have. I believe starting at task 5 on down you have double checkboxes in column A

Option Explicit

Sub abc()
 Const shProjectDirectory As String = "Project Directory"
 Const shProjectBuild As String = "Project Build"
 Const shTemplate As String = "Template"
 Dim sProjectName As String
 Dim sProjectNumber As String
 Dim sProjectManager As String
 
 Dim ck As CheckBox
 Dim sTemp As String
 Dim iStartingRow As Long
 Dim iCount As Long
 
 iStartingRow = 7
 With Worksheets(shProjectBuild)
    sProjectName = Trim$(.Range("c2").Text)
    sProjectNumber = Trim$(.Range("c3").Text)
    sProjectManager = Trim(.Range("c4").Text)
    
    sTemp = GoodSheetName(sProjectNumber)
    If Evaluate("=ISREF('" & sTemp & "'!A1)") Then
        MsgBox "Sheet " & sTemp & " already exists."
        Exit Sub
    End If
    Sheets(shTemplate).Copy After:=Sheets(Sheets.Count)
    
    For Each ck In .CheckBoxes
        
        If ck > 0 Then
            iCount = iCount + 1
            Cells(1, "e").Offset(iCount) = _
            Worksheets(shProjectBuild).Cells(iStartingRow, "b").Text
            Cells(1, "n").Offset(iCount) = "In Progress"
        End If
        ck.Value = 0
       iStartingRow = iStartingRow + 1
    Next
    ActiveSheet.Name = sTemp
 End With
 With Worksheets(shProjectDirectory)
    With .Cells(Rows.Count, "a").End(xlUp).Offset(1)
        .Resize(, 4) = Array(sProjectNumber, sProjectName, iCount, sProjectManager)
    End With
 End With
End Sub

Private Function GoodSheetName(ByVal strName As String) As String
  
     Dim vaIllegal As Variant
     Dim i As Long
     
    'List unwanted characters
    vaIllegal = Array(".", "?", "!", "*", "/", "", "[", "]", "‘", Chr(34), "|", "<", ">", "\", ":")
     
    'Remove all illegals
    For i = LBound(vaIllegal) To UBound(vaIllegal)
         strName = Replace(strName, vaIllegal(i), "")
     Next i
     
    GoodSheetName = Left$(Trim$(strName), 31)
     
End Function