PDA

View Full Version : Need to Add New Columns of Data in Existing Workbook Using Excel VBA Macro



greenbcz
06-15-2017, 05:14 AM
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
06-15-2017, 11:05 PM
Eagerly waiting for any helpful response(s).
Thank you.

greenbcz
06-16-2017, 10:36 PM
Looking forward to helpful response.

mdmackillop
06-17-2017, 12:58 AM
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
06-17-2017, 02:21 AM
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
06-17-2017, 06:37 AM
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
06-17-2017, 06:57 AM
Hi xld,
Thank you. Can you please elaborate how will your code work to add new columns?

mdmackillop
06-17-2017, 09:49 AM
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
06-21-2017, 09:08 PM
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
06-22-2017, 10:47 AM
A lot of changes to create required functionality. Need rigorous testing. New locations/deletions to be entered via the Instructions sheet

greenbcz
06-26-2017, 02:18 AM
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
06-26-2017, 12:47 PM
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