Solved: VBA Delete Error 400

[hobbiton73]

Hi, I wonder whether someone may be able to help me please with a urgent query.

I'm using the code below to remove cell content from a user input form. I'm using a cell 'Content Removal' method rather than a 'Delete Row' because I wish to maintain the 'Input Range'.

[VBA]Sub DelRow()
Dim msg

Sheets("Input").Protect password", 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
With Range("A7:AG400" & Cells(Rows.Count, "A").End(xlUp).Row)
.Sort Key1:=Range("B7"), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

End With
End Sub[/VBA]

The code works fine except in one scenario.

1. 'User A' enters data into rows 1-4, saves, and closes the file.
2. 'User B' then enters data into rows 5-8, saves and closes the file.
3. 'User A' then opens the file again and filters the spreadsheet on their name. They then start to enter another row of data. However because they have applied the filter this record appears on row 392.'
4. 'User A' then removes the filter where they are faced with hundreds of empty rows between the last record created by 'User B' and the the new record they have just created.

The problem I have is that when they highlight the empty rows and action the 'Delete Row' macro shown above, they receive a 'Error 400' error message, thus rendering the file useless.


I've been trying to work this out all day at work without any success.


I just wondered whether someone could possibly look at this please and help and offer some help as to how I may over come thius.


Many thanks and the kindest regards

[Bob Phillips]

Can you post the workbook?

[hobbiton73]

Hi @xld, thank you very much once more for taking the time to reply to one of my posts.

Please find attached the test file and I've set up the scenario in question.

If you try to delete rows 12 to 15 by selecting the row numbers(s) and click the 'Delete Row' button, you will receive the 'Error 400' message.

Having worked on this a little today I think really what I would like the code to do is

• When the user selects the row or rows, and clicks the 'Delete' button, check to see if there is a value in column B, if there is remove cell content as per my existing code,
• If however, there is no cell content in column B shift all blank rows to the bottom of the spreadsheet.

I hope this makes sense and once again, thank you for your time and trouble.


Many thanks and kind regards


Chris

[hobbiton73]

Hi @xld, this is just a quick note to say that I received from help from @DougClancy elsewhere, who helped me with the solution below:

[VBA]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.Range("A7:AG400").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[/VBA]

Thank you very much for all your time and trouble

Kind regards

Chris