Creating worksheet change with KeyCells Range from different worksheet

[Tdorman]

I am trying to create a worksheet that will create columns depending on the value of a cell. So if I input 10 as the value, 10 columns will be created with the appropriate formulas. I was able to achieve that, however, I would like the range to pull a value from a different worksheet. I wasn't sure if that was possible and if so, how to do it. If it is not, is there a way to have the sheet that I want the columns to appear on refresh once I enter the value on the other sheet, so I can link that value to each sheet it is needed? I will have multiple sheets that will depend on this value to display information. For example, as noted above, if I enter 10 on sheet 1 then on sheets 2 thru 15, 10 columns will be created with their own formatting depending on the sheet requirements.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range, ColNum As Long, TotalCol As Long, LeftFixedCol As Long
Dim Rng As Range, c As Range

Set KeyCells = Range("B2")
 
If Application.Intersect(KeyCells, Target) Is Nothing Then Exit Sub
If IsNumeric(KeyCells.Value) = False Then Exit Sub
 

ColNum = KeyCells.Value
If ColNum <= 0 Then Exit Sub
Set Rng = Range(Cells(4, 1), Cells(4, Columns.Count))
Set c = Rng.Find("END")     
If c Is Nothing Then Exit Sub
TotalCol = c.Column
LeftFixedCol = 1 


Dim i As Integer
If TotalCol < LeftFixedCol + ColNum + 1 Then 
        For i = TotalCol To LeftFixedCol + ColNum
        Columns(i).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Cells(4, i).Value = "Member" & i - LeftFixedCol 
        Cells(5, i).Value = "=DATA!$A$2"
        Cells(6, i).Value = "=OFFSET(DATA!$C$2,COLUMN()-2,0)"
        Cells(7, i).Value = "=OFFSET(DATA!$D$2,COLUMN()-2,0)"
        Cells(8, i).Value = "=OFFSET(DATA!$E$2,COLUMN()-2,0)"
        Cells(10, i).Value = "=OFFSET(DATA!$F$2,COLUMN()-2,0)"
        Cells(12, i).Value = "=OFFSET(DATA!$G$2,COLUMN()-2,0)"
        Cells(13, i).Value = "=OFFSET(DATA!$H$2,COLUMN()-2,0)"
        Cells(14, i).Value = "=OFFSET(DATA!$I$2,COLUMN()-2,0)"
        Next i
End If
If TotalCol > LeftFixedCol + ColNum + 1 Then 
        For i = TotalCol - 1 To LeftFixedCol + ColNum + 1 Step -1
            Columns(i).Delete
        Next i

End If
End Sub

 

[GWteB]

Hi @Tdorman, welcome to MrExcel.

If I understood correctly, the code below does what you want. If not, then at least you might be getting an idea of how to go about it.

I would like the range to pull a value from a different worksheet.

In my approach both the particular value as well as the worksheet to be affected are injected into an other procedure (instead of pulling the value).
That way we only need one procedure that can be used for each of the desired worksheets.

This goes in the module of the first worksheet:

Private Sub Worksheet_Change(ByVal Target As Range)

    Const SOMESHEETS As String = "*Sheet3*Sheet4*Sheet5*Sheet6*"     ' <<< 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("B2")
    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 CBool(InStr(LCase(SOMESHEETS), LCase("*" & ws.Name & "*"))) Then
                        InsertColumnsOnSheet argSheet:=ws, argColNum:=ColNum
                    End If
                Next ws
            End If
        End If
    End If
End Sub

This goes in a standard module:

Public Sub InsertColumnsOnSheet(ByVal argSheet As Worksheet, ByVal argColNum As Long)

    Dim Rng As Range, c As Range
    Dim TotalCol As Long, LeftFixedCol As Long
    Dim i As Long

    With argSheet
        Set Rng = .Range(.Cells(4, 1), .Cells(4, .Columns.Count))
        Set c = Rng.Find("END")
        If Not c Is Nothing Then
            TotalCol = c.Column
            LeftFixedCol = 1
            If TotalCol < LeftFixedCol + argColNum + 1 Then
                For i = TotalCol To LeftFixedCol + argColNum
                    .Columns(i).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                    .Cells(4, i).Value = "Member" & i - LeftFixedCol
                    .Cells(5, i).Value = "=DATA!$A$2"
                    .Cells(6, i).Value = "=OFFSET(DATA!$C$2,COLUMN()-2,0)"
                    .Cells(7, i).Value = "=OFFSET(DATA!$D$2,COLUMN()-2,0)"
                    .Cells(8, i).Value = "=OFFSET(DATA!$E$2,COLUMN()-2,0)"
                    .Cells(10, i).Value = "=OFFSET(DATA!$F$2,COLUMN()-2,0)"
                    .Cells(12, i).Value = "=OFFSET(DATA!$G$2,COLUMN()-2,0)"
                    .Cells(13, i).Value = "=OFFSET(DATA!$H$2,COLUMN()-2,0)"
                    .Cells(14, i).Value = "=OFFSET(DATA!$I$2,COLUMN()-2,0)"
                Next i
            End If
            If TotalCol > LeftFixedCol + argColNum + 1 Then
                For i = TotalCol - 1 To LeftFixedCol + argColNum + 1 Step -1
                    Columns(i).Delete
                Next i
            End If
        End If
    End With
End Sub

 

[Tdorman]

Hi GWteB,

Thank you so much for your help with this. When I enter all of this I get a Compile Error Sub or Function not defined, when changing the value. The InsertColumnsOnSheet part of the
InsertColumnsOnSheet argSheet:=ws, argColNum:=ColNum line is highlighted.

​

 

[GWteB]

Did you copy/paste both procedures?

 

[Tdorman]

Yes, copied and pasted exactly what you had provided. Changed the sheet names on the Const SOMESHEETS As String line to match the sheet names that were needed and got that error

 

[Tdorman]

This is the code that i used

Private Sub Worksheet_Change(ByVal Target As Range)

    Const SOMESHEETS As String = "*Mem&Aff*Sheet2*"
                                                                     
    Dim KeyCells As Range, ColNum As Long
    Dim ws As Worksheet
    
    Set KeyCells = Range("B2")
    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 CBool(InStr(LCase(SOMESHEETS), LCase("*" & ws.Name & "*"))) Then
                        InsertColumnsOnSheet argSheet:=ws, argColNum:=ColNum
                    End If
                Next ws
            End If
        End If
    End If
End Sub

Public Sub InsertColumnsOnSheet(ByVal argSheet As Worksheet, ByVal argColNum As Long)

    Dim Rng As Range, c As Range
    Dim TotalCol As Long, LeftFixedCol As Long
    Dim i As Long

    With argSheet
        Set Rng = .Range(.Cells(4, 1), .Cells(4, .Columns.Count))
        Set c = Rng.Find("END")
        If Not c Is Nothing Then
            TotalCol = c.Column
            LeftFixedCol = 1
            If TotalCol < LeftFixedCol + argColNum + 1 Then
                For i = TotalCol To LeftFixedCol + argColNum
                    .Columns(i).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                    .Cells(4, i).Value = "Member" & i - LeftFixedCol
                    .Cells(5, i).Value = "=DATA!$A$2"
                    .Cells(6, i).Value = "=OFFSET(DATA!$C$2,COLUMN()-2,0)"
                    .Cells(7, i).Value = "=OFFSET(DATA!$D$2,COLUMN()-2,0)"
                    .Cells(8, i).Value = "=OFFSET(DATA!$E$2,COLUMN()-2,0)"
                    .Cells(10, i).Value = "=OFFSET(DATA!$F$2,COLUMN()-2,0)"
                    .Cells(12, i).Value = "=OFFSET(DATA!$G$2,COLUMN()-2,0)"
                    .Cells(13, i).Value = "=OFFSET(DATA!$H$2,COLUMN()-2,0)"
                    .Cells(14, i).Value = "=OFFSET(DATA!$I$2,COLUMN()-2,0)"
                Next i
            End If
            If TotalCol > LeftFixedCol + argColNum + 1 Then
                For i = TotalCol - 1 To LeftFixedCol + argColNum + 1 Step -1
                    Columns(i).Delete
                Next i
            End If
        End If
    End With
End Sub

 

[GWteB]

I get a Compile Error Sub or Function not defined

That means the compiler cannot find the InsertColumnsOnSheet procedure. I have no explanation for that, it all works for me. And it should even work if you put both procedures together in the worksheet module.

 

[Tdorman]

I was able to get it to work, however, it is only adding columns. Is there anyway to have it remove columns if that number is lowered?

 

[GWteB]

it is only adding columns.

That's also what your original code did. I just split your original procedure into two procedures so that it can be used for multiple worksheets. That was your original request.

Is there anyway to have it remove columns if that number is lowered?

I'm sure that would be possible but we don't know what your data looks like. Apart from the foregoing, the nature of your additional question differs from your original request. So I think it's fair to ask you to start a new thread.

 

[Tdorman]

When i used the original code the amount of columns would change depending on the value in the keycells range. If I had a value of 10 it would add 10 columns. If I then changed that to 5 it would then change to 5 columns and I could switch back and forth. This new method has allowed me to link the sheets to the new range, however, now I can only add columns and not remove them like before. For example, if I add 10 columns like before, I can now only increase the amount of columns and not revert back to 1 or less then 10. If a new thread needs to be started, that's fine, either way your help has been much appreciated