Need to Add New Columns of Data in Existing Workbook Using Excel VBA Macro

[greenbcz]

• Hi everyone!
  
  In attached file, on the “January” tab, I have tried to add additional columns (CL to CO) for the clinic named Walpole Street, which would display or be hidden if the checkbox is marked in the same way as other clinics do. However, when I create a macro similar to the other clinics/columns, it doesn’t seem to work.
  
  I would like to correct this, then add three other sets of columns (with the same layout/structure as others). These additional columns should be inserted before the column “IST” (CP to CS) and be able to be displayed or hidden based on a checkbox on the left of the screen. Then these columns will need to be added to each of the other monthly tabs, so that they all have the same information.
  
  Is it possible for the new columns and checkboxes to be entered alphabetically (as is the case for all the columns currently) instead of at the right of the spreadsheet? The three new groups of columns will be headed as "Northwood", "St. Lukes" and "Other" (although "Other" can be positioned to the left of "IST").
  
  I’m sure that there is a quick and easy way to update the macro in place to do this, and probably another to copy these changes to the other tabs/worksheets.
  
  Finally, when the “Reset Worksheet” is clicked, is there a way to remove the checkmarks from the boxes on the left of the screen?
  
  Please let me know if the above does not make sense - it's a little tricky to explain exactly what I'm after.
  Looking forward to helpful responses. Thank you!
  
  
  
  

[greenbcz]

Eagerly waiting for any helpful response(s).
Thank you.

[greenbcz]

Looking forward to helpful response.

[mdmackillop]

As they say, to get where you're going, I wouldn't start from here.
The code as written is too inflexible.
I would put the locations on two similar userforms.
The first to be used initially to set locations that would show relevant columns on every month.
The second would be used to adapt each sheet as required. It would be populated based on the active sheet and changes would affect that sheet only.
Rather than hard coding cell references, use Find based on Row 10 to locate areas and show/hide as appropriate. Get rid of the merged cells, they make things more difficult.
Try and use modular code. Pass the Checkbox values to another sub to carry out the procedure e.g.

 Private Sub CheckBox10_Click()
    With CheckBox10
        ColShow .Caption, .Value
    End With
End Sub


Sub ColShow(Loc As String, Val As Boolean)
    Dim c As Long
    With ActiveSheet
        .Unprotect
        c = .Rows(10).Find(Loc).Column
        .Columns(c).Resize(, 4).EntireColumn.Hidden = Not (Val)
        .Protect
    End With
End Sub

Create code that can be used on all worksheets by refering to the data structure

Sub ClearWorksheet()
    ' ClearWorksheet Macro
    Dim i As Long
    Dim arr, a
    Dim LR As Long
    Dim LC As Long
    With ActiveSheet
        .Unprotect
        LR = .Cells(11, 4).End(xlDown).Row
        LC = .Cells.Find("TAKEN", lookat:=xlPart, After:=.Cells(1, 1), searchdirection:=xlPrevious, searchorder:=xlByColumns).Column
        arr = Array(0, 1, 3)
        For i = 6 To (LC - 3) Step 4
            For Each a In arr
                Range(.Cells(12, i), .Cells(LR, i)).Offset(, a).Select 'ClearContents
            Next a
        Next i
    End With
    Columns(10).Resize(, LC - 9).EntireColumn.Hidden = True
    DoProtect ActiveSheet
End Sub
 
Sub ShowAll()
    ' Keyboard Shortcut: Ctrl+Shift+S
    ActiveSheet.Unprotect
    Cells.EntireColumn.Hidden = False
    DoProtect ActiveSheet
End Sub
 
Sub DoProtect(sh As Worksheet)
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
    AllowDeletingColumns:=True, AllowDeletingRows:=True
End Sub

[Bob Phillips]

This works for me

Sub Other_macro()
    
    With ActiveSheet

        .Unprotect
    
        .Columns("CH:CK").Hidden = Not Range("A24").Value
    
        .Columns("CL:CO").Hidden = Not Range("A25").Value

        .Protect
    End With
End Sub

[greenbcz]

Hi mdmackillop,


Thank you for your valuable response. Can you please confirm that:


* Do you suggest to assign CheckBox10_Click function to all check boxes?
* Do you suggest to assign ClearWorksheet function to 'Reset Worksheet' button?
* Do you suggest to assign ShowAll function to 'Show All Clinics' button?


If answers are yes, then I have assigned it as per the suggestions. However when I attempt to check a checkbox, 'Run-time error: 424' comes up against following line of 'CheckBox10_Click' function:


ColShow .Caption, .Value

Can you please check again? Also how can I alter your code to fulfill the requirement of adding additional columns?
Waiting for quick response please!

[greenbcz]

Hi xld,
Thank you. Can you please elaborate how will your code work to add new columns?

[mdmackillop]

That suggestion was for a userform solution which yould be a totally different approach to your workbook. Not knowing how it is to be used, I can't advise the best approach.
This will add additional columns, but not deal with the checkbox or associated code.

Sub AddCols()
    Dim NewLoc As String
    Dim x As Long
    Dim sh As Worksheet
    Application.ScreenUpdating = True
    Set sh = Sheets("January")
    NewLoc = InputBox("Enter new location", , "Test")
    x = Application.Match(NewLoc, sh.Rows(10))
    OldCol = Cells(10, x).Interior.Color
    NewCol = GetColorindex
    
    For i = 1 To 12
        With Sheets(MonthName(i))
            .Unprotect
            .Columns(x).Resize(, 4).Copy
            .Columns(x + 4).Resize(, 4).Insert Shift:=xlToRight
            .Cells(10, x + 4).Formula = NewLoc
            Call ReplaceColour(.Columns(x + 4).Resize(, 4), OldCol, NewCol)
            DoProtect Sheets(MonthName(i))
        End With
    Next i
    Application.ScreenUpdating = False
End Sub




Sub ReplaceColour(Rng, Old, Nw)
    With Application
        .FindFormat.Interior.Color = Old
        .ReplaceFormat.Interior.Color = Nw
    End With
    Rng.Replace What:="", Replacement:="", SearchFormat:=True, ReplaceFormat:=True
End Sub


'-----------------------------*------------------------------*--------------
Function GetColorindex(Optional Text As Boolean = False) As Long
    'https://www.excelforum.com/excel-general/534043-color-picker-in-excel.html
    Dim rngCurr As Range
    Dim oThis As Object
    
    Application.ScreenUpdating = False
    Set oThis = ActiveSheet
    Set rngCurr = Selection
    Range("IV1").Select
    Application.Dialogs(xlDialogPatterns).Show
    GetColorindex = ActiveCell.Interior.Color
    If GetColorindex = xlColorIndexAutomatic And Not Text Then
        GetColorindex = xlColorIndexNone
    End If
    ActiveCell.Interior.Color = xlColorIndexAutomatic
    rngCurr.Select
    Application.ScreenUpdating = True
End Function


Sub DoProtect(sh As Worksheet)
    sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
    AllowDeletingColumns:=True, AllowDeletingRows:=True
End Sub

[greenbcz]

Hi mdmackillop,

Thank you. Your code really helps in providing for addition of new columns. Can this code and workbook be somehow modified so that it can also provide additional check boxes along with respective additional set of column? I just need three additional check boxes with three sets of columns to be mentioned in alphabetical order as described in first post. Also I need to solve the issue of 'Wimpole Street' option which when checked is not being depicted in form of columns.

[mdmackillop]

A lot of changes to create required functionality. Need rigorous testing. New locations/deletions to be entered via the Instructions sheet

[greenbcz]

Thanks. The "add new location" button on the instruction worksheet does not work. I get a debug error. This is also the case when checking the box "Trial" on any worksheet.

If you use the "delete location" button in error, is there a way to reverse it?

[mdmackillop]

The "add new location" button on the instruction worksheet does not work

Did you add Location and Colour to cell T2?

If you use the "delete location" button in error, is there a way to reverse it?

No, but you can add the location again. You could also add confitrmation code to confirm before deletion. Any data added will be lost though