Consulting

Results 1 to 3 of 3

Thread: Solved: Stop Them Deleting Rows

  1. #1
    VBAX Contributor
    Joined
    Aug 2007
    Posts
    188
    Location

    Solved: Stop Them Deleting Rows

    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.

    [VBA]
    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
    [/VBA]

    Many Thanks

    Sooty8

  2. #2
    Moderator VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,003
    Location
    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
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

  3. #3
    VBAX Contributor
    Joined
    Aug 2007
    Posts
    188
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •