Excel 2003 - Need to detect Cell Insert shift left or shift down or Entire Column

[frank_m]

Hoping to have a change event that will warn me if a cell is inserted (shifting other cells down, or left, or if an entire column is inserted.

Similar to the awesome solution that xld provide me for detecting if a row is inserted
http://www.vbaexpress.com/forum/showthread.php?t=35423

In case it makes a difference I need this to work in conjunction with my current incorporation of xld's code, except that the new code should only provide msgbox warning's such as "Warning Cell Inserted and shifted down" or "Warning Cell inserted and Shifted Left" or "Warning Entire Column was inserted"

If it's difficult to cover all of those, then just detecting a Column insert & working in conjunction with the row insert shown below will be very helpful.

Below is my version of xld's code that covers what I need to happen if a Row is inserted. (so far this has been working great)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Columns.Count = Me.Columns.Count And Application.CountIf(Target, "") = Me.Columns.Count Then
With Cells(Target.Row, 27).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 3
.Weight = xlThick
End With
End If
End Sub Thanks

[frank_m]

I seemed to have worked out the column insert detection part of my request, by substituting the key word columns with Rows in xld's code
If Target.Rows.Count = Me.Rows.Count And Application.CountIf(Target, "") = Me.Rows.Count Then
MsgBox "Column insert is not allowed. The procedure will now attempt to undo the insert." _
& vbNewLine & "If the undo attempt fails please seek help from your supervisor immediately"

Application.Undo
End If

[frank_m]

I've got the Column insert detection taken care of thanks to some copy-cat work I did by studying xld's code,
but anyone have any ideas about detecting a cell insert ?

Thank you much :help

[frank_m]

if it makes it easier my only desperate need is to detect a cell inserted in Column H, (and H always has data in it's last row cell before an insert)

sorry if I'm being a pest

[frank_m]

Below is what I have come up with so far.

With limited testing the code below is offering me some protection (in Column H), (some protection is all I am in great need of really),
from inserting a single cell shifted Down, or Shifted to the Right, or deleting a single cell in the same Column H.

And it offers me all the protection I need against accidental editing in Column K

and thanks to xld's code the the procedure is adding the Thick Red Left Side Border In Column R after a row is inserted.

and offers as much protection as I was wanting against accidentally inserting a Column.

The code isn't very pretty though, so if anyone cares to help improve it, I'll certainly welcome it !!!! :yes

I've attached a Demo workbook so that you may better see what it does and or so you might tinker with it.

Thanks
Option Explicit

Public oldval As Variant
Public newval As Variant

Public BOOLchgRw As Boolean


Private Sub Worksheet_Change(ByVal Target As Range)

'Prevents Edit Change protection if the selection is on or above the header row, or not in Column 11
If Target.Row < 16 Or Target.Column <> 11 Then GoTo skipCol_11_ChangeCode

Application.EnableEvents = False
'http://www.eggheadcafe.com/software/aspnet/35555715/disable-clear-dcontents-command-in-excel--vba-code.aspx
newval = Target.Value
If oldval = "" Then
Target = newval
Else
MsgBox "Only a Supervisor is granted access to change the value in Column K"
Target = oldval
oldval = ""
newval = ""
End If

Application.EnableEvents = True

skipCol_11_ChangeCode:

If Target.Row < 16 Then GoTo skipInsertCellCheck

'uncomment next line if detection for only one Column is needed, ie: Column 8
If Target.Column <> 8 Then GoTo skipInsertCellCheck

Application.EnableEvents = False

If Not BOOLchgRw Then
MsgBox "E R R O R -- A Cell was improperly Inserted or deleted." _
& vbNewLine & "This procedure will now attempt to undo the insert or deletion of the cell" _
& vbNewLine & "If the undo attempt fails, please get advice from your Supervisor immediately"
Application.Undo
Application.EnableEvents = True
'exit sub avoids an object required error with column insert check
Exit Sub
End If

skipInsertCellCheck:

Application.EnableEvents = True
If Target.Rows.Count = Me.Rows.Count And Application.CountIf(Target, "") = Me.Rows.Count Then
MsgBox "Column insert is not allowed. The procedure will now attempt to undo the insert." _
& vbNewLine & "If the undo attempt fails please seek help from your supervisor immediately"
Application.Undo
End If

Application.EnableEvents = True

'On Error Resume Next avoids an object required error with column insert check
On Error Resume Next
If Target.Columns.Count = Me.Columns.Count And Application.CountIf(Target, "") = Me.Columns.Count Then
With Cells(Target.Row, 18).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 3
.Weight = xlThick
End With
On Error GoTo 0
End If

End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Static TheRow As Range

Dim LastRow As Long

'http://www.eggheadcafe.com/software/aspnet/35555715/disable-clear-dcontents-command-in-excel--vba-code.aspx
If Target.Column <> 11 Then GoTo NextBlockOfCode
oldval = Target.Value

NextBlockOfCode:
Application.ScreenUpdating = False
On Error Resume Next ' to avoid error setting LastRow variable if rows are filtered
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If TheRow Is Nothing Then
With Range("A1:Q" & LastRow - 1)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
On Error GoTo 0
Else
With TheRow
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
End If
If ActiveCell.Row > 15 Then
If Target.Rows.Count = 1 And Target.Row < LastRow Then
Set TheRow = Target.EntireRow.Resize(, 17)
With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
End If
End If
Range("A15:Q15").Interior.ColorIndex = 12
If ActiveCell.Column < 18 Then Cells(15, ActiveCell.Column).Interior.ColorIndex = 45


Application.ScreenUpdating = True
End Sub
Edit: Replaced the attachment. The difference is not code, or functionality related, as I merely edited the description in the Column H heading

[frank_m]

Rev 3 attachment has filters applied, as filtered rows has various effects with the code testing.
- I think I have contained the possible errors(, but I can't be sure)

also I reworded the column H heading & reworded a code comment about the fact that only Column H is protected & only from single cell Insert or delete.