Inserting Cells via Event macros

B

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.
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
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! :)
 
Upvote 0
JS411 said:
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! :)
Click to expand...





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
 
Upvote 0
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:
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
VBA for using a check box to Regen that row and then uncheck the box (ready to run macro again)
Replies
1
Views
494
Micron
M
C
  • Question
Using the Find method to copy 4 cell values above Find = X to another sheet for every value of X found in a column
Replies
6
Views
345
chazrab
C
L
  • Question
Inserting Note Based on Cell Value
Replies
5
Views
1K
davesexcel
davesexcel
R
  • Question
Formatting using VBA
Replies
0
Views
410
RandyD123
R
M
  • Question
Range.Find Result Changing Irrationally After Inserting Columns and Naming Cells
Replies
2
Views
417
matt767
M

Forum statistics

Threads
1,214,587
Messages
6,120,406
Members
448,958
Latest member
Hat4Life

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