Generate dynamic templates with varying mandatory and non-mandatory fields depending on the product type chosen.

[RajK2005]

Hello Everyone,

I am trying to generate an All-in-One sheet which will auto-populate templates as sheets based on the product type chosen.

Currently, we share a single Google Drive folder containing 450 templates, and they chose which to download and enter values. Each of those excel files have 1 template based on product type, and master_list. Data-Validation is added to each cell in the template.

Different product types will have different attributes (some of them mandatory, some of them optional). I have the reference sheet showing which attributes are mandatory, which are non-mandatory and which don't apply to the product type at all. There are close to 400 attributes in total across 500+ product types. Some attributes are free-text and some only accept certain values (listed in Master_List" sheet).

So I am thinking of making a single Macro enabled workbook where a seller can choose a product type and it will auto-populate a new sheet with the template for the product type. So the newly generated product type template, will have only those attributes as columns which are either mandatory and non-mandatory. 2nd row will mention which attributes are mandatory and which are non-mandatory. 3rd row will have a drop-down for all attributes which accept limited inputs. It will be a Table.

Here's a sample Sheet.

I am a beginner in VBA. As of now, I have an idea of a long winded way of doing it because I think all the steps that I need for this, I can find some vba online and maybe combine it all.

I have the reference sheet called "Templates_Guide"

In the select sheet, client will chose product_type.

Here's my long-winded version.

• It will create a copy of "templates_guide", rename that sheet to Product_Type chosen.
• Then remove all rows except the 1st row and the row containing the same product type in 1st column.
• Then remove blank columns (which only have the attribute headers but nothing in 2nd row).
• Then convert that into a Table including the 3rd row.
• Add Drop-down validation to the 3rd row wherever the column attribute exists in "Master_List". I have a working Vba for the same already.
• The Table & Data Validation should extend accordingly if they enter anything in subsequent rows or copy paste a list in any attribute column.
• BONUS: If a mandatory field is empty or any entered data is not acceptable (based on Master_List), highlight it. But not at the cost of slowing down the entire excel due to conditional formatting.
• If the client chooses another product, repeat the same so we have a new template in a new sheet.

I think I can find VBAs online for each of steps and maybe combine them. With my skills, it will take me a week just for that, provided I find all such VBAs but I am optimistic.

But I was hoping, maybe someone can do it or guide me more efficiently.

These will be shared with our clients whose expertise on excel is unknown. So it would be better if they don't have to do anything complicated to enable macros or run them. All of this should be very user-friendly.

Thanks in Advance.

 

[RajK2005]

@Akuini
Hi, as you said to ask a question by starting a new thread, I am tagging you here. This was a thread I started last month but never got any response. However, I did work on this as I explained in the thread with the long-winded version and came up with quite a long and working VBA. It works well almost all the times.

Here it is:

Sub Copyrenameworksheet()
    Dim sourceSheet As Worksheet
    Dim Ws          As Worksheet
    Dim TemplateSheet As Worksheet
    Dim col         As Long
    Dim rng         As Range
    Dim tbOb        As ListObject
    Dim SheetName   As String
    Dim TemplateToKeep   As String
    Dim i As Long, j As Long, n As Long, rc As Long, h As Long, table_size As Long
    Dim c As Range, f As Range
    Dim tx As String
    Dim va, x
    Dim d As Object
    Dim t As Single

    
    
    Sheets("Category_Tree").Select 'Category sheet is where you select the product type in the 1st cell.
    Set wh = Worksheets(ActiveSheet.Name)
    
    TemplateToKeep = wh.Range("A1").Value 'product type
    SheetName = Left(wh.Range("A1").Value, 30) 'product type but trimmed to 30 characters as sheets cannot have a longer name.
    
    
    
    'check if a sheet already exists by the name of the product_type and if it exists, switch to that sheet.
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = SheetName Then
            exists = True
            MsgBox "Template already generated. Click OK to switch to the Template", , "Completed"
            Sheets(SheetName).Select
        End If
    Next i
    
    
    
    'if it doesn't exist unhide & copy the sheet "Template-Mandates"
    If Not exists Then
        Worksheets("Templates-Mandates").Visible = True
        Sheets("Templates-Mandates").Select
        
        
        
        'Rename the sheet to the product type trimmed to 30 characters.
        ActiveSheet.Copy After:=Worksheets(Sheets.Count)
        If wh.Range("A1").Value <> "" Then
            ActiveSheet.Name = SheetName
        End If
        
        'hide the sheet "Template-Manadtes"
        Worksheets("Templates-Mandates").Visible = False
        
        'Filter out the rows that doesn't match the prodct type chosen in E column.
        Application.ScreenUpdating = False
        With Range("E1", Range("E" & Rows.Count).End(xlUp))
            .AutoFilter Field:=1, Criteria1:="<>" & TemplateToKeep
            .Offset(1).EntireRow.Delete
            .AutoFilter
        End With
        Application.ScreenUpdating = True
        
        'Remove columns which are empty. 2nd rows will contain mandatory or non-mandatory or nothing. Those that are nothing should be removed.
        Application.ScreenUpdating = False
        For col = 500 To 1 Step -1
            If Application.CountA(Columns(col)) = 1 Then Columns(col).Delete
        Next col
        Application.ScreenUpdating = True
        
        'set table size
        table_size = 252
        
        
        Set TemplateSheet = Worksheets(ActiveSheet.Name)
        
        TemplateSheet.Activate
        
        'clear formatting
        Cells.Select
        Selection.ClearFormats
                
        'count the number of columns
        rc = Cells(1, Columns.Count).End(xlToLeft).Column
        
        'set the range to create table
        Set rng = Range(Cells(1, 1), Cells(table_size, rc))
        
        'create table with the same name as the sheet name
        
        Set tbOb = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
        tbOb.Name = SheetName
        tbOb.TableStyle = "TableStyleMedium7"
        ActiveSheet.ListObjects(SheetName).ShowAutoFilterDropDown = False
        
        Range("E2").Value = "Mandatory"
        
        'set conditional formatting such that any value in the 1st column with a space is highlighted with given color.
        Range("A3").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.FormatConditions.Add Type:=xlTextString, String:=" ", _
                                       TextOperator:=xlContains
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 16751052
            .TintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        
        'Set conditional formatting to highlights duplicates in B column.
        Range("B3").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.FormatConditions.AddUniqueValues
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        Selection.FormatConditions(1).DupeUnique = xlDuplicate
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = True
        
    'set conditional formatting to highlight cells in B column with length more than 100
    Range("B3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B3)>100"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 8421504
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
        
        
        'This applies for every row starting from C3 to last cell in the table.
        'if it is blank, then False
        'If it is not blank, then check if the header of it's column matches any column header in master_list i.e the named range "headers" (Master_List!$A$1:$HX$1)
        'if it doesn't, then False.
        'if it does, then check if the value in C3 is in the drop-down list by Matching it with the named range.
        'This named range is named the same as the header of that column. It's range is in master_list.
        'In effect, it highlights any cells whose value doesn't match the drop-down list.
        
        
        Range("C3").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
                                       "=IF(C3="""", FALSE, IF(ISNUMBER(MATCH(C$1,Headers,0)),NOT(ISNUMBER(MATCH(C3, INDIRECT(C$1), 0))),FALSE))"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Font
            .Color = -16754788
            .TintAndShade = 0
        End With
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 10284031
            .TintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        
        'This applies for every row starting from B3 to last cell in the table.
        'if it is blank AND the column header is mandatory (indicated in 2nd row) AND A3 is not blank, then true.
        'This implies a mandatory value is blank for a product whose sku is mentioned in A column.
        Range("B3").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
                                       "=IF(AND(B3="""", B$2=""Mandatory"", $A3<>""""), TRUE, FALSE)"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Font
            .Color = -16383844
            .TintAndShade = 0
        End With
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13551615
            .TintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = True
        
        
        'Adding the dropdowns
        Set sourceSheet = ThisWorkbook.Worksheets("Master_List")
        
        With sourceSheet
            va = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
        End With
        
        Set d = CreateObject("scripting.dictionary"):    d.CompareMode = vbTextCompare
        
        For Each x In va
            d(x) = Empty
        Next
        
        TemplateSheet.Activate
        
        For Each c In tbOb.HeaderRowRange
            h = h + 1
            
            If d.exists(c.Value) Then
                Set f = c.Offset(2).Resize(table_size - 2)        'dropdown start at row 3
                tx = Replace(c.Value, " ", "_")
                tx = "=" & Replace(tx, ",", "_")
                
                With f.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=tx
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = False
                    .ShowError = False
                End With
                
            End If
        Next
        
        Cells(3, 1).Select
        
        MsgBox "Template generated", , "Completed"
    End If
    
End Sub

I was hoping you could help me with 3 things:

1) When run on older version, this seems to stop working and dropdowns aren't added. My client tried on, I think, 2007 version but it stopped at this line with following error.

Maybe if you can adapt this so that it works on most Excel versions, that would be great?

2) Does the dropdown addition method you used of creating scripting dictionary need some special privilege's for the user? When I run this, it usually works for me. I have my office's Anti-virus disabled. However, my colleagues when they try, it ends at this part:

Set d = CreateObject("scripting.dictionary"):    d.CompareMode = vbTextCompare

And the anti-virus gives a message that this script was blocked due to threat. Can something be done to avoid it so that certain anti-virus doesn't block it? We use Cylance Protect.

3) Anything else you can do to make it run faster & smoother? I think the conditional formatting alone will be a drag in most cases. Also, the part of deleting blank columns. Using debug I see it runs a loop on every column (400)+. That means it takes 3-4 seconds for this to completely execute.

Any help on this will be really helpful. Thanks in advance.