0

I wonder whether someone may be able to help me please.

For a few weeks now I've been trying to find a solution whereby users can do the following:

  • Delete rows with and without data,
  • Shift all rows containing data aso that they sit one under another,
  • Whilst maintaining a defined 'Input Range'

I've put together the following script which clears the cell contents and hence doesn't alter the 'Input Range'.

Sub DelRow()

      Dim msg

          Sheets("Input").Protect "handsoff", userinterfaceonly:=True
          Application.EnableCancelKey = xlDisabled
          Application.EnableEvents = False
          msg = MsgBox("Are you sure you want to delete this row?", vbYesNo)
          If msg = vbNo Then Exit Sub
          With Selection
              Application.Intersect(.Parent.Range("A:S"), .EntireRow).Interior.ColorIndex = xlNone
              Application.Intersect(.Parent.Range("T:AE"), .EntireRow).Interior.ColorIndex = 42
              Selection.SpecialCells(xlCellTypeConstants).ClearContents
              Application.Intersect(.Parent.Range("C:AE"), .EntireRow).Locked = True
              Application.Intersect(.Parent.Range("AG:AG"), .EntireRow).Locked = True
          End With
              Application.EnableEvents = True
      End Sub

Updated Code

Sub DelRow()
Dim RangeToClear As Range
Dim msg As VbMsgBoxResult

'Sheets("Input").Protect "handsoff", userinterfaceonly:=True
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
msg = MsgBox("Are you sure you want to delete this row?", vbYesNo)
If msg = vbNo Then Exit Sub
With Selection
    Application.Intersect(.Parent.Range("A:S"), .EntireRow).Interior.ColorIndex = xlNone
    Application.Intersect(.Parent.Range("T:AE"), .EntireRow).Interior.ColorIndex = 42
    On Error Resume Next
    Set RangeToClear = Selection.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0    ' or previously defined error handler
    If Not RangeToClear Is Nothing Then
        RangeToClear.ClearContents
    Else
    Selection.Sort Key1:=Range("B7"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End If
    Application.Intersect(.Parent.Range("C:AE"), .EntireRow).Locked = True
    Application.Intersect(.Parent.Range("AG:AG"), .EntireRow).Locked = True
End With
Application.EnableEvents = True
End Sub

The problem with this though, is that if a user selects a blank row they receive a 'Error 400' message and it doesn't shift the rows up to sit underneath each other.

As I said, I've spent so much time on this trying to find a solution without any success.

I really would be so grateful if someone could look at this please and offer some guidance on how I may achieve this.

Many thanks and kind regards

5
  • According to support.microsoft.com/?kbid=146864 runtime error 400 is "Form already displayed; can't show modally" at least in Excel 97(!). That doesn't seem to apply. Is the error on the ClearContents line? What's the wording of the error? Feb 9, 2013 at 15:20
  • Hi @DougGlancy, thank you for taking time to reply to my post. The error simply says '400'. If it helps, I've set up a test file here: box.com/s/cnptwwmnmzoooirrgos2. You'll see that in rows 8-11 there is data in column B. I've then added data to rows 46 and and 47, again in column B. If you highlight the blank rows in between and try to delete them you will receive the error in question. Many thanks and kind regards
    – IRHM
    Feb 9, 2013 at 15:32
  • Well, I see one error, with your ClearContents line if the Selection is blank, so I'll answer for that and see if it helps. Feb 9, 2013 at 15:34
  • So, it sounds like you want to sort if you clear the contents. That means the sort code should not be in an Else clause, but in the If clause. I'll try once more to modify my answer to get what you want. Feb 9, 2013 at 16:03
  • Hi @DougGlancy, thank you, yes that's what I'd like to achieve if at all possible. Kind regards
    – IRHM
    Feb 9, 2013 at 16:06

1 Answer 1

0

If the selection is blank, the line Selection.SpecialCells(xlCellTypeConstants).ClearContents will fail because there are no xlCellTypeConstants. You need to test this and only clear the content if there are any:

EDIT: To try to answer Sorting question

I think you just want to sort no matter what, so I just moved the Sort to after the ClearContents. I sorted the UsedRange though, which I don't think is what you want. You need to define the range to be sorted, either as a named range using the Name Manager in Excel, or in your code.

Sub DelRow()
Dim RangeToClear As Range
Dim msg As VbMsgBoxResult

Sheets("Input").Protect "handsoff", userinterfaceonly:=True
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
msg = MsgBox("Are you sure you want to delete this row?", vbYesNo)
If msg = vbNo Then Exit Sub
With Selection
    Application.Intersect(.Parent.Range("A:S"), .EntireRow).Interior.ColorIndex = xlNone
    Application.Intersect(.Parent.Range("T:AE"), .EntireRow).Interior.ColorIndex = 42
    On Error Resume Next
    Set RangeToClear = Selection.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0    ' or previously defined error handler
    If Not RangeToClear Is Nothing Then
        RangeToClear.ClearContents
    End If
    'You need to define a range that you want sorted
    'here I've used UsedRange
    ActiveSheet.UsedRange.Sort Key1:=Range("B7"), Order1:=xlAscending, Header:=xlNo, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                   DataOption1:=xlSortNormal

    Application.Intersect(.Parent.Range("C:AE"), .EntireRow).Locked = True
    Application.Intersect(.Parent.Range("AG:AG"), .EntireRow).Locked = True
End With
Application.EnableEvents = True
End Sub
3
  • Hi @Doug Clancy, thank you very much for this. This sorts out the error message, thank you!, but unfortunately it doesn't shift the rows so that those with data sit under each other. COuld you tell me please have you any ideas? Many thanks and kind regards
    – IRHM
    Feb 9, 2013 at 15:35
  • Hi, thank you very much for this. As you suggested I recorded a macro to sort the info, but I must have gone wrong somewhere along the lines. I was trying to add a 'Else If' to the line: `RangeToClear.ClearContents, so that if the rows were blank, the rows would shift up. When I've run this, although I don't receive any error message, the sorting doesn't work and no change is made to the sheet. I've edited my original post with the updated code. Could you possibly have a look at this please and let me know where I've gone wrong. Many thanks and kind regards.
    – IRHM
    Feb 9, 2013 at 15:56
  • Hi @DougClancy, thank you very much for this, it works beautifully. I really can't express my thanks enough, it taken me weeks to get to this point. Many thanks and kind regards.
    – IRHM
    Feb 9, 2013 at 16:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.