Inserting Cells via Event macros

Bluhawk

New Member
Joined
Apr 10, 2013
Messages
8
So I'm really new to vba and excel, but there's this thing that I want to get done and it didn't seem hard to do at first but after a fair amount of hours spent browsing through countless posts about similar problems I've decided to just ask, because my case is a little bit different than most.

I'll just throw in this image to try and picture what I have in mind and see if you can understand it.

heyhh.jpg

I've tried fooling around with Range("C2").Select then a Do Loop until and using a counter with an auxiliar variable to Fire multiple (X amount) of Selection.Insert Shiftdown copyfromtop Insertions But I get frustrated not really understanding what I'm doing not to mention 4 out of 5 times the module goes into infinite loop, so I figured why not ask the savvys!. Thanks in advance!



PD. Worth mentioning that I intend to insert CELLS and not an entire ROW. It would be perfect to just shift the cells in B and C columns only but I dont see how that could be possible without more complex code I probably wouldn't understand.
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
Hi and Welcome to the Board,

A key decision is whether you want to limit the code to responding to changes to single cells (entering a number in any single cell in column "C"), versus supporting entries to multiple cells (ie through a Paste Operation). The single cell limitation simplifies the code quite a bit, so it would be best if possible.

To keep your code from triggering repeated event calls, use Application.EnableEvents like this:

Code:
Application.EnableEvents=False
'....your code that you don't want to trigger events
'....
Application.EnableEvents=True

Rather than repeating inserting of a 1 row by 2 column range (N) times, consider just inserting an N rows by 2 column range once.

Just ask if you want help with specific code - but I don't want to take away all your fun! :)
 

Bluhawk

New Member
Joined
Apr 10, 2013
Messages
8
Hi and Welcome to the Board,

A key decision is whether you want to limit the code to responding to changes to single cells (entering a number in any single cell in column "C"), versus supporting entries to multiple cells (ie through a Paste Operation). The single cell limitation simplifies the code quite a bit, so it would be best if possible.

To keep your code from triggering repeated event calls, use Application.EnableEvents like this:

Code:
Application.EnableEvents=False
'....your code that you don't want to trigger events
'....
Application.EnableEvents=True

Rather than repeating inserting of a 1 row by 2 column range (N) times, consider just inserting an N rows by 2 column range once.

Just ask if you want help with specific code - but I don't want to take away all your fun! :)





I'm sorry for the wall of code I'm about to throw at you (it's mostly copy/paste though), but I'm very limited when it comes to trimming code, I guess it's probably way easier than the way I coded it and could be done in WAAAAAY fewer lines.
The code below does exactly what I want: Depending on the Target.Value being input it does a copy/paste of some cells from a non visible part of the workbook into cells below of the target (this is done via target.offset). Using
"ActiveSheet.Range("O120").End(xlUp).Row" I was able to know for each X input if a line had to be inserted or deleted.

Problem is: I need to add a reference in other worksheet to each cell being inserted through the method above, BUT I cannot possibly do this even if I "lock" the reference (eg. =Sheet1!$A$1). The reference still moves as if the lock wasn't even there.

Is there a workaround for this ?


PS: Is there a way to learn VBA without having to look through countless posts for every little thing I want to code? Online manuals you recommend ? I'd think I'd benefit from a complete list of functions, anyone know of such a thing?


THANKS!




Code:
Private Sub Worksheet_Change(ByVal Target As Range)If Intersect(Range("P92:T92"), Target) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Select Case Target.Column
Case 16
Select Case Target.Value
            Case 1
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Exit Sub
                Case 94
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T94").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 95
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                End Select
                    
            Case 2
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU1").Select
                Selection.Copy
                Target.Offset(2, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                    Exit Sub
                Case 95
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                End Select
                
            Case 3
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU2").Select
                Selection.Copy
                Target.Offset(2, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU2").Select
                Selection.Copy
                Target.Offset(3, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                 Exit Sub
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O96:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                 If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O96:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                End Select
            Case 4
                 Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU3").Select
                Selection.Copy
                Target.Offset(2, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU3").Select
                Selection.Copy
                Target.Offset(3, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                Application.ScreenUpdating = False
                Range("AP3:AU3").Select
                Selection.Copy
                Target.Offset(4, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 96
                 Exit Sub
                 Case 97
                 If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O97:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                 End Select
            Case 5
             Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU4").Select
                Selection.Copy
                Target.Offset(2, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU4").Select
                Selection.Copy
                Target.Offset(3, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                Application.ScreenUpdating = False
                Range("AP3:AU4").Select
                Selection.Copy
                Target.Offset(4, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 96
                Application.ScreenUpdating = False
                Range("AP4:AU4").Select
                Selection.Copy
                Target.Offset(5, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 97
                Exit Sub
                End Select
            Case ""
            Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Exit Sub
                Case 94
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T94").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 95
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                Case 96
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                End Select
            Case Else
            MsgBox ("Values 1 to 5 only")
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
            Exit Sub
                End Select
                
            


Case 17


Select Case Target.Value
            Case 1
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Exit Sub
                Case 94
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T94").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 95
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                End Select
                    
            Case 2
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU1").Select
                Selection.Copy
                Target.Offset(2, -2).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                    Exit Sub
                Case 95
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                End Select
                
            Case 3
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU2").Select
                Selection.Copy
                Target.Offset(2, -2).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU2").Select
                Selection.Copy
                Target.Offset(3, -2).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                 Exit Sub
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O96:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                 If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O96:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                End Select
            Case 4
                 Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU3").Select
                Selection.Copy
                Target.Offset(2, -2).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU3").Select
                Selection.Copy
                Target.Offset(3, -2).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                Application.ScreenUpdating = False
                Range("AP3:AU3").Select
                Selection.Copy
                Target.Offset(4, -2).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 96
                 Exit Sub
                 Case 97
                 If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O97:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                 End Select
            Case 5
             Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU4").Select
                Selection.Copy
                Target.Offset(2, -2).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU4").Select
                Selection.Copy
                Target.Offset(3, -2).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                Application.ScreenUpdating = False
                Range("AP3:AU4").Select
                Selection.Copy
                Target.Offset(4, -2).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 96
                Application.ScreenUpdating = False
                Range("AP4:AU4").Select
                Selection.Copy
                Target.Offset(5, -2).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 97
                Exit Sub
                End Select
            Case ""
            Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Exit Sub
                Case 94
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T94").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 95
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                Case 96
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                End Select
            Case Else
            MsgBox ("Values 1 to 5 only")
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
            Exit Sub
                End Select
                
            


Case 18
Select Case Target.Value
            Case 1
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Exit Sub
                Case 94
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T94").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 95
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                End Select
                    
            Case 2
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU1").Select
                Selection.Copy
                Target.Offset(2, -3).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                    Exit Sub
                Case 95
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                End Select
                
            Case 3
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU2").Select
                Selection.Copy
                Target.Offset(2, -3).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU2").Select
                Selection.Copy
                Target.Offset(3, -3).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                 Exit Sub
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O96:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                 If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O96:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                End Select
            Case 4
                 Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU3").Select
                Selection.Copy
                Target.Offset(2, -3).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU3").Select
                Selection.Copy
                Target.Offset(3, -3).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                Application.ScreenUpdating = False
                Range("AP3:AU3").Select
                Selection.Copy
                Target.Offset(4, -3).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 96
                 Exit Sub
                 Case 97
                 If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O97:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                 End Select
            Case 5
             Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU4").Select
                Selection.Copy
                Target.Offset(2, -3).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU4").Select
                Selection.Copy
                Target.Offset(3, -3).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                Application.ScreenUpdating = False
                Range("AP3:AU4").Select
                Selection.Copy
                Target.Offset(4, -3).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 96
                Application.ScreenUpdating = False
                Range("AP4:AU4").Select
                Selection.Copy
                Target.Offset(5, -3).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 97
                Exit Sub
                End Select
            Case ""
            Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Exit Sub
                Case 94
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T94").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 95
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                Case 96
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                End Select
            Case Else
            MsgBox ("Values 1 to 5 only")
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
            Exit Sub
                End Select
                
            






Case 19
Select Case Target.Value
            Case 1
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Exit Sub
                Case 94
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T94").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 95
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                End Select
                    
            Case 2
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU1").Select
                Selection.Copy
                Target.Offset(2, -4).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                    Exit Sub
                Case 95
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                End Select
                
            Case 3
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU2").Select
                Selection.Copy
                Target.Offset(2, -4).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU2").Select
                Selection.Copy
                Target.Offset(3, -4).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                 Exit Sub
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O96:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                 If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O96:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                End Select
            Case 4
                 Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU3").Select
                Selection.Copy
                Target.Offset(2, -4).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU3").Select
                Selection.Copy
                Target.Offset(3, -4).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                Application.ScreenUpdating = False
                Range("AP3:AU3").Select
                Selection.Copy
                Target.Offset(4, -4).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 96
                 Exit Sub
                 Case 97
                 If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O97:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                 End Select
            Case 5
             Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU4").Select
                Selection.Copy
                Target.Offset(2, -4).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU4").Select
                Selection.Copy
                Target.Offset(3, -4).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                Application.ScreenUpdating = False
                Range("AP3:AU4").Select
                Selection.Copy
                Target.Offset(4, -4).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 96
                Application.ScreenUpdating = False
                Range("AP4:AU4").Select
                Selection.Copy
                Target.Offset(5, -4).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 97
                Exit Sub
                End Select
            Case ""
            Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Exit Sub
                Case 94
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T94").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 95
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                Case 96
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                End Select
            Case Else
            MsgBox ("Values 1 to 5 only")
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
            Exit Sub
                End Select
                
            


Case 20


Select Case Target.Value
            Case 1
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Exit Sub
                Case 94
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T94").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 95
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O94:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                End Select
                    
            Case 2
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU1").Select
                Selection.Copy
                Target.Offset(2, -5).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                    Exit Sub
                Case 95
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O95:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                End Select
                
            Case 3
                Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU2").Select
                Selection.Copy
                Target.Offset(2, -5).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU2").Select
                Selection.Copy
                Target.Offset(3, -1).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                 Exit Sub
                Case 96
                If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O96:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                 If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O96:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                End Select
            Case 4
                 Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU3").Select
                Selection.Copy
                Target.Offset(2, -5).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU3").Select
                Selection.Copy
                Target.Offset(3, -5).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                Application.ScreenUpdating = False
                Range("AP3:AU3").Select
                Selection.Copy
                Target.Offset(4, -5).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 96
                 Exit Sub
                 Case 97
                 If Target.Value >= Application.WorksheetFunction.Max(Range("P92:T92")) Then
                Range("O97:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                 End Select
            Case 5
             Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Application.ScreenUpdating = False
                Range("AP1:AU4").Select
                Selection.Copy
                Target.Offset(2, -5).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 94
                Application.ScreenUpdating = False
                Range("AP2:AU4").Select
                Selection.Copy
                Target.Offset(3, -5).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 95
                Application.ScreenUpdating = False
                Range("AP3:AU4").Select
                Selection.Copy
                Target.Offset(4, -5).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 96
                Application.ScreenUpdating = False
                Range("AP4:AU4").Select
                Selection.Copy
                Target.Offset(5, -5).Select
                Selection.Insert shift:=xlDown
                Target.Offset(1, 0).Activate
                Case 97
                Exit Sub
                End Select
            Case ""
            Select Case ActiveSheet.Range("O120").End(xlUp).Row
                Case 93
                    Exit Sub
                Case 94
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T94").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 95
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T95").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                Case 96
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T96").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                End If
                Case 97
                If Application.WorksheetFunction.Max(Range("P92:T92")) = 0 Then
                Range("O94:T97").Select
                Selection.Delete shift:=xlUp
                Target.Offset(1, 0).Activate
                
                End If
                End Select
            Case Else
            MsgBox ("Values 1 to 5 only")
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
            Exit Sub
                End Select
                
            
End Select
End Sub
 

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
I'd suggest you break the project down into smaller parts.

Your original post was good starting point. Your latest example adds multiple columns for the entry, moves the working range away from A1, and copy-inserts blank cells instead of just inserting cells.

You'll solve the problem faster and better if you get this working nicely for your first example, then progress from there.

Similarly, creating references from another sheet to the added cells, should wait until you have the cell insertion problem solved.

Will that approach work for you?

One clarification, would it work to move the cells down (by reading them and writing them X cells below), or is there a reason that cells need to be inserted?
 
Last edited:

Bluhawk

New Member
Joined
Apr 10, 2013
Messages
8
Thing is I'm working with a Grid that helps fill up a big form. I put up this rather simple grid to do the task of sending the data to the form cells via references. The grid is 6 columns long (a description cell + 5 different forms filling cell's columns) and 20-30 rows long (for data entry). The idea for the code is to allow me to "shrink" the grid a bit by giving the user the option to imput the number of items (required in an area of the forms) to be filled with data. If the user imputs a 5 for eg. then the idea would be to expand the grid 5 rows (not entire rows, just 6 cells in that column range).

That's why the code I posted works for me. As the cells are already in a hidden area of the workbook, I don't have to worry about keeping grid format and coding for real insertion. I was thinking that maybe if I cut instead of copy, and reverse the cut instead of deleting would maybe solve the reference problem. I'll try that later as I'm at work now.

As to your questions

- Yes and I'll try that later.

- If I understood correctly, what you mean is reading A to G grid cells and moving them X rows below, therefore leaving X blank rows in the middle of X input cell and A. That would work but I don't know where that would take me as to grid format and I think it'd get me into trouble with the references.

Correct me if I'm wrong, but wouldn't inserting cells still move the references even if locked with "$" ?

Thanks a lot, Jerry.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,258
Messages
5,600,568
Members
414,389
Latest member
MarkElla

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
Top