Adding Columns with Worksheet Change event having multiple conditions

Tdorman

New Member
Joined
Aug 12, 2021
Messages
40
Office Version
  1. 2016
Platform
  1. Windows
I have a worksheet change event that will add columns to worksheets based on a value. I am trying to get it to add columns to certain sheets based on one value and add a different amount of columns to different worksheets based on a value from a different cell. The code is:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Const SOMESHEETS As String = "*MemberInfo-20*C-Proposal-20*Schedule J-20*NOL-20*Schedule R-20*NOL-P-20*SchA-3-20*Schedule H-20*NOL-PA-20*Schedule A-20*Schedule A-5-20*C-Proposal-19*MemberInfo-19*Schedule J-19*NOL-19*NOL-P-19*NOL-PA-19*Schedule R-19*Schedule A-3-19*Schedule A-19*Schedule H-19*"      ' <<< change / append sheet names to suit
                                                                                                                                             '     be sure each sheet name is between * characters
    Dim KeyCells As Range, ColNum As Long
    Dim ws As Worksheet
    
    Set KeyCells = Range("B30")
    If Not Application.Intersect(KeyCells, Target) Is Nothing Then
        If IsNumeric(KeyCells.Value) Then
            ColNum = KeyCells.Value
            If ColNum > 0 Then
                For Each ws In ThisWorkbook.Worksheets
                    If ws.Visible = xlSheetVisible Then 'Skip this Sheet and process next sheet
                    If CBool(InStr(LCase(SOMESHEETS), LCase("*" & ws.Name & "*"))) Then
                            InsertColumnsOnSheet argSheet:=ws, argColNum:=ColNum
                    End If
                    End If
                Next ws
            End If
        End If
    End If
End Sub

I need every sheet listed with a -19 to have the range of B30 and everything with a -20 to have a range of B36
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
The below code solved the issue

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
                                                                                                                                             
    Dim KeyCells As Range, ColNum As Long
    Dim ws As Worksheet

    
        SOMESHEETS = "*C-Proposal-19*MemberInfo-19*Schedule J-19*NOL-19*NOL-P-19*NOL-PA-19*Schedule R-19*Schedule A-3-19*Schedule A-19*Schedule H-19*"
        Set KeyCells = Range("B30")
        If Not Application.Intersect(KeyCells, Target) Is Nothing Then
            If IsNumeric(KeyCells.Value) Then
                ColNum = KeyCells.Value
                If ColNum > 0 Then
                 For Each ws In ThisWorkbook.Worksheets
                     If ws.Visible = xlSheetVisible Then
                     If CBool(InStr(LCase(SOMESHEETS), LCase("*" & ws.Name & "*"))) Then
                            InsertColumnsOnSheet argSheet:=ws, argColNum:=ColNum
                     End If
                     End If
                 Next ws
                End If
            End If
        End If
        

    
    SOMESHEETS = "*MemberInfo-20*C-Proposal-20*Schedule J-20*NOL-20*Schedule R-20*NOL-P-20*SchA-3-20*Schedule H-20*NOL-PA-20*Schedule A-20*Schedule A-5-20*"
    Set KeyCells = Range("B36")
    If Not Application.Intersect(KeyCells, Target) Is Nothing Then
        If IsNumeric(KeyCells.Value) Then
            ColNum = KeyCells.Value
            If ColNum > 0 Then
                For Each ws In ThisWorkbook.Worksheets
                    If ws.Visible = xlSheetVisible Then
                    If CBool(InStr(LCase(SOMESHEETS), LCase("*" & ws.Name & "*"))) Then
                            InsertColumnsOnSheet argSheet:=ws, argColNum:=ColNum
                    End If
                    End If
                Next ws
            End If
        End If
    End If
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,214,625
Messages
6,120,598
Members
448,973
Latest member
ksonnia

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top