PDA

View Full Version : Solved: Stop Them Deleting Rows



sooty8
06-23-2008, 12:27 AM
Hi All

I read somewhere on this forum and I think it was by Xld that deleting rows was really going to mess up a sheet if there was information that was needed to do calculations elsewhere on the sheet. I have tried to stop some of the idiots I work with from deleting rows and instead get them to just clear the cells in which they have entered the error. The macro below works Ok until someone has deleted a row then all 'ell lets loose is there anything I can add that would stop them.


Sub Macro3()
Application.ScreenUpdating = False
Sheets("InputData").Select
Range("A1:S1").Select
Selection.Copy
Sheets("Result").Select
Range("A3:S3").Select
ActiveSheet.Paste
Sheets("InputData").Select
Range("A3:S3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Result").Select
Range("A5:S5").Select
ActiveSheet.Paste
Sheets("InputData").Select
Range("B6:S35").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Result").Select
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B8:S37").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("J8"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("Result").Select
Range("A8").Select
ActiveCell.FormulaR1C1 = "1st"
Range("A8").Select
Selection.AutoFill Destination:=Range("A8:A37"), Type:=xlFillDefault
Range("A8:A37").Select
Range("A8:S37").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("A38:J38").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A39:S39").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlNone
.ColorIndex = xlAutomatic
End With
Application.ScreenUpdating = True
End Sub


Many Thanks

Sooty8

Simon Lloyd
06-23-2008, 01:04 AM
There is a good example in our kb about preventing deletion of rows or columns by Justin Blane
http://www.vbaexpress.com/kb/getarticle.php?kb_id=660

sooty8
06-23-2008, 01:14 AM
Hi Simon

Brilliant -- to put it bluntly I now have them by the short & curlies.

Many Many Thanks for pointing me in the right direction

Sooty8