Creating worksheet change with KeyCells Range from different worksheet

T

Tdorman

Board Regular
Joined
Aug 12, 2021
Messages
50
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code: 
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
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
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.
Tdorman said:
I would like the range to pull a value from a different worksheet.
Click to expand...
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:
VBA Code: 
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:
VBA Code: 
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
 
Upvote 0
Solution
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.

​

 
Upvote 0
Did you copy/paste both procedures?
 
Upvote 0
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
 
Upvote 0
This is the code that i used

VBA Code: 
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

VBA Code: 
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
 
Upvote 0
Tdorman said:
I get a Compile Error Sub or Function not defined
Click to expand...
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.
 
Upvote 0
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?
 
Upvote 0
Tdorman said:
it is only adding columns.
Click to expand...
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.

Tdorman said:
Is there anyway to have it remove columns if that number is lowered?
Click to expand...
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.
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA lookup by taking common column from user
Replies
2
Views
193
StephenCrump
S
T
  • Solved
Inserting columns based on keycells value issue
Replies
1
Views
729
Tdorman
T
A
  • Solved
Fixing the macro for text splitting (rows being skipped)
Replies
6
Views
448
Georgiboy
Georgiboy
N
  • Question Question
Myrna Larson-Permutations and Combinations
Replies
0
Views
300
Norman A
N
X
  • Question Question
how to get data form html frame but not first div
Replies
1
Views
299
xyz987
X

Forum statistics

Threads
1,223,909
Messages
6,175,314
Members
452,634
Latest member
cpostell

Share this page

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