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]

I was unable to test both your original code and the derivative code I provided. As I said, it is very difficult to be of help if one lacks insight into the data used. Providing some sample data of the worksheets you're using would be helpful, both of the starting situation and of the desired result. Please don't use a screenshot for this but use XL2BB (over here, download button on the top right), which allows helpers on this forum to copy the data simply by pressing a button.

 

[Tdorman]

Test3.xlsm
	A	B	C	D	E	F	G
1		Total Member
2		2
3
4
5
6
7
8
9
10
11
12
13
Sheet1

Test3.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1
2
3
4		Managerial Member	Member2	Member3	Member4	Member5	Member6	Member7	Member8	Member9	Member10	END
5	Unitary ID Number	NU1111111111	NU1111111111	NU1111111111	NU1111111111	NU1111111111	NU1111111111	NU1111111111	NU1111111111	NU1111111111	NU1111111111
6	Member Name	AAAAAAAAA	BBBBBBBBB	CCCCCCCCC	DDDDDDDDD	EEEEEEEEE	FFFFFFFFF	GGGGGGGGG	HHHHHHHHH	IIIIIIIII	JJJJJJJJJ
7	Member FEIN	1111111111	2222222222	3333333333	4444444444	5555555555	6666666666	7777777777	8888888888	9999999999	11111111110
Sheet2

Cell Formulas
Range	Formula
B5:K5	B5	=Data!$A$2
B6:K6	B6	=OFFSET(Data!$C$2,COLUMN()-2,0)
B7:K7	B7	=OFFSET(Data!$D$2,COLUMN()-2,0)

Test3.xlsm
	A	B	C	D
1	UnitaryID	ManagerialEIN(*LineOneOnly*)	MemberName	MemberEIN
2	NU1111111111	1111111111	AAAAAAAAA	1111111111
3	NU1111111111	2222222222	BBBBBBBBB	2222222222
4	NU1111111111	3333333333	CCCCCCCCC	3333333333
5	NU1111111111	4444444444	DDDDDDDDD	4444444444
6	NU1111111111	5555555555	EEEEEEEEE	5555555555
7	NU1111111111	6666666666	FFFFFFFFF	6666666666
8	NU1111111111	7777777777	GGGGGGGGG	7777777777
9	NU1111111111	8888888888	HHHHHHHHH	8888888888
10	NU1111111111	9999999999	IIIIIIIII	9999999999
11	NU1111111111	11111111110	JJJJJJJJJ	11111111110
12	NU1111111111	12222222221	KKKKKKKKK	12222222221
13	NU1111111111	13333333332	LLLLLLLLL	13333333332
14	NU1111111111	14444444443	MMMMMMMMM	14444444443
15	NU1111111111	15555555554	NNNNNNNNN	15555555554
16	NU1111111111	16666666665	OOOOOOOOO	16666666665
17	NU1111111111	17777777776	PPPPPPPPP	17777777776
18	NU1111111111	18888888887	QQQQQQQQQ	18888888887
19	NU1111111111	19999999998	RRRRRRRRR	19999999998
20	NU1111111111	21111111109	SSSSSSSSS	21111111109
21	NU1111111111	22222222220	TTTTTTTTT	22222222220
22	NU1111111111	23333333331	UUUUUUUUU	23333333331
23	NU1111111111	24444444442	VVVVVVVVV	24444444442
24	NU1111111111	25555555553	WWWWWWWWW	25555555553
25	NU1111111111	26666666664	XXXXXXXXX	26666666664
26	NU1111111111	27777777775	YYYYYYYYY	27777777775
27	NU1111111111	28888888886	ZZZZZZZZZ	28888888886
28	NU1111111111	29999999997	ABCDEFGHI	29999999997
Data

 

[GWteB]

Hi @Tdorman, I'm really trying to understand what you want but I can't yet. Would you like to tell us concretely and step by step what your ultimate goal is? Both with regard to inserting columns on the various target worksheets and deleting columns that you talked about in your previous post. After all, if there are already several columns and you decrease the number on the first worksheet in cell B2, how do you think you can determine which columns (and on which worksheets) should be deleted? In short, the entire process is completely unclear to me.

 

[Tdorman]

Sorry for the confusion @GWteB. Essentially, I need to have Sheet 2 insert or add columns based on the value in cell B2 from sheet 1. If that value is 2 I need 2 columns to be added, which is currently working. The issue I run into, is when I change the value of cell B2 on sheet 1 back to 1, or a lesser value than was previously reported. When the value is reduced it doesn't not remove columns. It would be helpful to delete the columns because the value in cell B2 on sheet 1 could be fluid and constantly changing. This wasn't an issue with the original code because it would add the amount of columns based on the value in B2 and if I reduced that value it would adjust the amount of columns to reflect that value. Ideally, the value in B2 would match the amount of members in the data sheet (Column C of the data sheet). So if there are 27 members as reported in Column C of the data tab, I would input 27 on cell B2 of Sheet 1 and have 27 columns inserted on Sheet 2. If the amount of members changes I would remove or add those members in the data sheet and adjust the value in cell B2 of sheet 1. Currently an increase of members is not a problem, a decrease in members is because the code is not deleting columns, only adding. I hope this makes the issue clearer. Thanks again for all your help with this

 

[GWteB]

Thanks for your explanation, this has clarified a lot.
I'm sorry to say a rather sloppy error had crept into my code
There was no explicit qualification for the columns to be removed, see the red colored statement below:

        If TotalCol > LeftFixedCol + argColNum + 1 Then
            For i = TotalCol - 1 To LeftFixedCol + argColNum + 1 Step -1
                .Columns(i).Delete   ' <<<< preceding dot was missing !!!!
'             ▲
            Next i
        End If

You could of course still try the code from my post #2 after making this correction, but given your previous explanation, I'm not sure whether this correction will have the desired effect.

Ideally, the value in B2 would match the amount of members in the data sheet (Column C of the data sheet).

This is useful information. Considering this aspect I took the liberty of taking a completely different approach. The code determines how many rows with data there are (starting on row 2), so you no longer have to do that yourself. Changing the contents of the source worksheet (Data) triggers the process. Your data is simply copied across, only the row on which each member is numbered contains formulas. This process is considerably faster compared to your original approach, i.e. inserting columns and placing formulas in each individual cell.
If you agree with this, paste the code below into the module behind worksheet Data. Note the separate functions, being dependencies of the Worksheet_Change event procedure and to be pasted in a standard module.
See if this works for you and let me know if adjustments are needed.

This goes in the module of worksheet Data:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim CurWs           As Worksheet
    Dim TargetWs        As Worksheet
    Dim TargetSel       As Range
    Dim SourceColumns   As Variant
    Dim DestinationRows As Variant
    Dim Source          As Range
    Dim Destination     As Range
    Dim luRow           As Long
    Dim luColumn        As Long
    Dim MsgTitle        As String
    Dim i               As Long

    MsgTitle = "Worksheet Change event procedure (" & Me.Name & ")"

    SourceColumns = Array("A", "C", "D", "E", "F", "G", "H", "I")   ' <<< columns on source sheet
    DestinationRows = Array(5, 6, 7, 8, 10, 12, 13, 14)             ' <<< rows on destination sheet

    If UBound(SourceColumns) = UBound(DestinationRows) Then

        Set TargetWs = ThisWorkbook.Sheets("Sheet2")                ' <<< change name of destination sheet to suit

        luRow = LastUsedRow(Me)
        If luRow < TargetWs.Columns.Count - 2 Then
            If luRow > 1 Then

                ' for visual and performance purposes
                Application.ScreenUpdating = False
                Application.Calculation = xlCalculationManual
                Application.EnableEvents = False
                Set CurWs = ActiveSheet
                TargetWs.Select
                Set TargetSel = Selection

                ' loop through list of columns to be copied
                For i = LBound(SourceColumns) To UBound(SourceColumns)
                    Set Source = Me.Range(Me.Cells(2, SourceColumns(i)), Me.Cells(luRow, SourceColumns(i)))
                    
                    With TargetWs.Range("B" & DestinationRows(i))           ' <<< change destination column (=B) to suit
                        luColumn = LastUsedColumn(.Parent)
                        ' ensure a successful Resize
                        luColumn = IIf(luColumn > 0, luColumn, 1)
                        Set Destination = .Resize(, luColumn)
                    End With
                    
                    Destination.ClearContents
                    Source.Copy
                    Destination.Resize(, Source.Count).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                Next i

                Set Destination = TargetWs.Range("C4").Resize(, luColumn)   ' <<< change first cell of destination row (=C4) to suit
                With Destination
                    .ClearContents
                    ' number of members to display may have decreased
                    luColumn = LastUsedColumn(.Parent)
                    If luColumn >= .Column Then
                        .Resize(, luColumn - (.Column - 1)).Formula = "=""Member "" & Column()-1"
                        .EntireColumn.AutoFit
                    End If
                End With

                ' tidy up
                TargetSel.Select
                CurWs.Select
                Application.CutCopyMode = False
                Application.Calculation = xlCalculationAutomatic
                Application.EnableEvents = True
                Application.ScreenUpdating = True

            Else
                MsgBox "It looks like there's no data to copy.", vbInformation, MsgTitle
            End If
        Else
            MsgBox "There are more rows of data than available columns!" & vbCrLf & _
                   "Nothing was copied.", vbExclamation, MsgTitle
        End If

    Else
        MsgBox "Both numbers of source columns and destination rows need to be equal!" & vbCrLf & _
               "Nothing was copied.", vbExclamation, MsgTitle
    End If
End Sub

This goes in a standard module:

Public Function LastUsedColumn(ByVal argSheet As Worksheet) As Long
    If Not argSheet Is Nothing Then
        With argSheet
            On Error Resume Next
            LastUsedColumn = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
        End With
    End If
End Function

Public Function LastUsedRow(ByVal argSheet As Worksheet) As Long
    If Not argSheet Is Nothing Then
        With argSheet
            On Error Resume Next
            LastUsedRow = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
                           SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
        End With
    End If
End Function