Remove Cell Content on Filetered Records

ir121973 · Apr 2, 2013

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

I'm using the code below to allow a user to remove cell content from a given row or rows chosen by the user.

Code:

[FONT='inherit']Sub DelRow()[/FONT]

  
  [FONT='inherit']    Dim DoesItExist As Range[/FONT]
  [FONT='inherit']    Dim msg As VbMsgBoxResult[/FONT]
  [FONT='inherit']    Dim RangeToClear As Range[/FONT]
  
  [FONT='inherit']    Sheets("Input").Protect "handsoff", UserInterfaceOnly:=True[/FONT]
  [FONT='inherit']    Application.EnableCancelKey = xlDisabled[/FONT]
  [FONT='inherit']    Application.EnableEvents = False[/FONT]
  [FONT='inherit']    msg = MsgBox("Are you sure you want to delete this row?", vbYesNo)[/FONT]
  [FONT='inherit']    If msg = vbNo Then Exit Sub[/FONT]
  [FONT='inherit']    With Range("B7", Range("B" & Rows.Count).End(xlUp))[/FONT]
  [FONT='inherit']        .Value = Evaluate("if(" & .Address & "<>"""",if(isnumber(search(""Enter your name""," & _[/FONT]
  [FONT='inherit']        .Address & ")),""""," & .Address & "),"""")")[/FONT]
  [FONT='inherit']    End With[/FONT]
  [FONT='inherit']    With Selection[/FONT]
  [FONT='inherit']        Application.Intersect(.Parent.Range("A:S"), .EntireRow).Interior.ColorIndex = xlNone[/FONT]
  [FONT='inherit']        Application.Intersect(.Parent.Range("T:AE"), .EntireRow).Interior.ColorIndex = 42[/FONT]
  [FONT='inherit']        On Error Resume Next[/FONT]
  [FONT='inherit']        Set RangeToClear = Selection.SpecialCells(xlCellTypeConstants)[/FONT]
  [FONT='inherit']        On Error GoTo 0    ' or previously defined error handler[/FONT]
  [FONT='inherit']        If Not RangeToClear Is Nothing Then[/FONT]
  [FONT='inherit']            RangeToClear.ClearContents[/FONT]
  [FONT='inherit']        End If[/FONT]
  
  [FONT='inherit']        ActiveSheet.Range("A7:AG400").Sort Key1:=Range("B7"), _[/FONT]
  [FONT='inherit']        Order1:=xlAscending, Header:=xlNo, _[/FONT]
  [FONT='inherit']        OrderCustom:=1, MatchCase:=False, _[/FONT]
  [FONT='inherit']        Orientation:=xlTopToBottom, _[/FONT]
  [FONT='inherit']        DataOption1:=xlSortNormal[/FONT]
  
  [FONT='inherit']        Application.Intersect(.Parent.Range("C:AE"), .EntireRow).Locked = True[/FONT]
  [FONT='inherit']        Application.Intersect(.Parent.Range("AG:AG"), .EntireRow).Locked = True[/FONT]
  [FONT='inherit']    End With[/FONT]
  [FONT='inherit']    Set DoesItExist = Sheets("Input").Range("B7:B10").Find("Enter your name")[/FONT]
  [FONT='inherit']    If Not DoesItExist Is Nothing Then Exit Sub[/FONT]
  [FONT='inherit']    Sheets("Input").Select[/FONT]
  [FONT='inherit']    Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "Enter your name"[/FONT]
  [FONT='inherit']    Columns("B:B").Locked = False  ' to unlock the whole column[/FONT]
  [FONT='inherit']    Columns("B:B").SpecialCells(xlCellTypeBlanks).Locked = True[/FONT]
  [FONT='inherit']    Application.EnableEvents = True[/FONT]
  [FONT='inherit']End Sub[/FONT]

The code works fine except for when the records in the spreadsheet are filtered.

For example if I filter the spreadsheet by "User A" and this user has five separate rows of data, even though I may only select to remove the content from one row, the contents from all five rows data is removed, and I've no idea why, despite spending most of today on this.

I just wondered whether someone could possibly look at this please and offer some guidance on where I've gone wrong.

Many thanks and kind regads

Chris

p45cal · Apr 2, 2013

Your problem lies in this line:

Set RangeToClear = Selection.SpecialCells(xlCellTypeConstants)

If the selection is only one cell, the Specialcells method will act on the whole sheet. You need for it to act on more than one cell to prevent this from happening. I don't know what might be acceptable, but perhaps something along the lines of

Set RangeToClear = Selection.resize(,2).SpecialCells(xlCellTypeConstants)

or

Set RangeToClear = Selection.entirerow.SpecialCells(xlCellTypeConstants)

may have it working for you.

ir121973 · Apr 3, 2013

Hi @p45cal, thank you very much once more for taking the time to respond to my post and for the solution.

I haven't had time to test this today, but I will be tomorrow and I'll let you know how I get on.

Many thanks and kind regards

Chris

ir121973 · Apr 4, 2013

Hi @p45cal, as promised, I said I'd let you know how I got on with the solutions you kindly provided.

Unfortunately, I was unable to get either solution to work, but after working on this all day I've managed to come up with the following solution:

Code:

[FONT='inherit']Sub DelRow()[/FONT]
  
  [FONT='inherit']    Dim RangeToClear As Range[/FONT]
  [FONT='inherit']    Dim msg As VbMsgBoxResult[/FONT]
  [FONT='inherit']    Dim DoesItExist As Range[/FONT]
  
  [FONT='inherit']    Sheets("Input").Protect "handsoff", UserInterfaceOnly:=True[/FONT]
  [FONT='inherit']    Application.EnableCancelKey = xlDisabled[/FONT]
  [FONT='inherit']    Application.EnableEvents = False[/FONT]
  [FONT='inherit']    msg = MsgBox("Are you sure you want to delete this row?", vbYesNo)[/FONT]
  [FONT='inherit']    If msg = vbNo Then Exit Sub[/FONT]
  [FONT='inherit']    With Selection[/FONT]
  [FONT='inherit']        Application.Intersect(.Parent.Range("A:S"), .EntireRow).Interior.ColorIndex = xlNone[/FONT]
  [FONT='inherit']        Application.Intersect(.Parent.Range("T:AE"), .EntireRow).Interior.ColorIndex = 42[/FONT]
  [FONT='inherit']        On Error Resume Next[/FONT]
  [FONT='inherit']        Set RangeToClear = Selection.SpecialCells(xlCellTypeConstants)[/FONT]
  [FONT='inherit']        On Error GoTo 0    ' or previously defined error handler[/FONT]
  [FONT='inherit']        If Not RangeToClear Is Nothing Then[/FONT]
  [FONT='inherit']            RangeToClear.ClearContents[/FONT]
  [FONT='inherit']        End If[/FONT]
  [FONT='inherit']        If Sheets("Input").FilterMode = True Then[/FONT]
  [FONT='inherit']            Sheets("Input").ShowAllData[/FONT]
  [FONT='inherit']        End If[/FONT]
  [FONT='inherit']        With Range("B7", Range("B" & Rows.Count).End(xlUp))[/FONT]
  [FONT='inherit']            .Value = Evaluate("if(" & .Address & "<>"""",if(isnumber(search(""Enter your name""," & _[/FONT]
  [FONT='inherit']            .Address & ")),""""," & .Address & "),"""")")[/FONT]
  [FONT='inherit']        End With[/FONT]
  [FONT='inherit']        ActiveSheet.Range("A7:AG400").Sort Key1:=Range("B7"), _[/FONT]
  [FONT='inherit']        Order1:=xlAscending, Header:=xlNo, _[/FONT]
  [FONT='inherit']        OrderCustom:=1, MatchCase:=False, _[/FONT]
  [FONT='inherit']        Orientation:=xlTopToBottom, _[/FONT]
  [FONT='inherit']        DataOption1:=xlSortNormal[/FONT]
  
  [FONT='inherit']        Application.Intersect(.Parent.Range("C:AE"), .EntireRow).Locked = True[/FONT]
  [FONT='inherit']        Application.Intersect(.Parent.Range("AG:AG"), .EntireRow).Locked = True[/FONT]
  [FONT='inherit']    End With[/FONT]
  
  [FONT='inherit']    If Not DoesItExist Is Nothing Then Exit Sub[/FONT]
  [FONT='inherit']    Sheets("Input").Select[/FONT]
  [FONT='inherit']    Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "Enter your name"[/FONT]
  [FONT='inherit']    Columns("B:B").Locked = False  ' to unlock the whole column[/FONT]
  [FONT='inherit']    Columns("B:B").SpecialCells(xlCellTypeBlanks).Locked = True[/FONT]
  [FONT='inherit']    Application.EnableEvents = True[/FONT]
  [FONT='inherit']End Sub[/FONT]

I appreciate that it may not be as elegant as something which a more seasoned developer may put together, and I'm not even sure whether there is a better way to do this, although I'd be more than happy to take on board any suggestions you, or indeed anyone else may have, but it's what I've been able to put together with my limited knowledge.

Onca again, many thanks for all your help.

Kind regards

Chris

Remove Cell Content on Filetered Records

ir121973

Active Member

Excel Facts

p45cal

Well-known Member

ir121973

Active Member

ir121973

Active Member

Similar threads

Forum statistics

Share this page

Remove Cell Content on Filetered Records

ir121973

Active Member

Excel Facts

p45cal

Well-known Member

ir121973

Active Member

ir121973

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock