Clear contents based on cell value

[edwardj3]

Hi,

I've found code which can clear cells including formats but the range is set.

Sub sbClearCells()
Range("A1:C10").Clear
End Sub

I want to remove all contents and formatting (cells have a black single line border) if the cell contains "No Data". I also need the code to remove the hourly segments in the cells above the "No Data" entries and the merged cells that has the date in it. Table example below. Hope you can see the formatting when you paste into excel.

Service	Service ID	08/01/2018	09/01/2018
24-01	01-02	02-03	03-04	04-05	05-06	06-07	07-08	08-09	09-10	10-11	24-01	01-02	02-03	03-04	04-05	05-06	06-07	07-08	08-09	09-10	10-11
Serv1	a	1	2	3	4	5	6	7	8	9	10	11	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data
Serv2	b	1	2	3	4	5	6	7	8	9	10	11	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data
Serv3	c	1	2	3	4	5	6	7	8	9	10	11	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data
Serv4	d	1	2	3	4	5	6	7	8	9	10	11	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data
Serv5	e	1	2	3	4	5	6	7	8	9	10	11	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data
Serv6	f	1	2	3	4	5	6	7	8	9	10	11	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data	No data

<colgroup><col span="24"></colgroup><tbody>
</tbody>

I've also found this other code which handles merged cells but I have no idea how it could be adapted to solve my issue.

Private Sub CommandButton1_Click()
Dim c As Range
Dim ma As Range
For Each c In Range("A1:C10")
Set ma = c.MergeArea
If ma.Address = c.Address Then
If IsNumeric(c) Then c.ClearContents
Else
If IsNumeric(ma.Cells(1, 1)) Then ma.Cells(1, 1).Value = ""
End If
Next c
End Sub​

Help would be appreciated.

 

[cooper645]

Re: VBA to delete cells

Sub ClearNoData()
Dim LastCol As Long
Dim cell As Range
Dim Rng1 As Range, Rng2 As Range
 
LastCol = Cells(3, Columns.Count).End(xlToLeft).Column
 
Set Rng1 = Range(Cells(3, 2), Cells(3, LastCol))
 
For Each cell In Rng1
    If cell.Value = "[COLOR=#ff0000]No data[/COLOR]" Then
        If Not Rng2 Is Nothing Then
            Set Rng2 = Union(Rng2, cell)
        Else
            Set Rng2 = cell
        End If
    End If
Next cell
 
Rng2.EntireColumn.Delete
 
End Sub

it looks for cells in row 3 that contain the words “ No data” as per you other post showed.
Mir assumes that No data in row 3 would also mean No data in rows 4,5,6 etc as well.

Test on a a copy of your work book first

 

[edwardj3]

Re: VBA to delete cells

Morning cooper645

I've copied your code into my workbook but when I run it I get an error message

Run-time error '91':

Object variable or With block variable not set.

Rng2.EntireColumn.Delete is highlighted.

I can see that the code is going to delete the entire columns. is it possible to change this so that only the contents and formatting are removed where the entry is "No Data"?
I would need the cells in row 2 and the merged cells in row 1 to be cleared.

If I delete the column I may delete valid data lower down in the work sheet.

 

[cooper645]

Re: VBA to delete cells

I have modified the code to clear the contents of those cells with "No data" in them, also to now look through the sheet.
I can't figure a way to clear the contents of the merged cell just yet, I am home with the little one so have a busier day ahead than normal.

I will check back later to try and solve this last bit for you when I can. It will probably just be as simple as checking a merged cell offset for "No data" before running the "No data" code.

I have run the code below on a worksheet set up as per your data and I get no errors thrown up.
I can get the error when the cells that contain "No data" don't appear because they are in lower case : "no data"

can you confirm that the cells you want emptying contain the words "No data"

Sub ClearNoData()
Dim LastCol As Long, LastRow As Long
Dim cell As Range
Dim Rng1 As Range, Rng2 As Range


LastCol = Cells(3, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row


Set Rng1 = Range(Cells(3, 2), Cells(LastRow, LastCol))


For Each cell In Rng1
If cell.Value = "No data" Then
If Not Rng2 Is Nothing Then
Set Rng2 = Union(Rng2, cell)
Else
Set Rng2 = cell
End If
End If
Next cell


Rng2.ClearContents


End Sub

 

[edwardj3]

Re: VBA to delete cells

Thanks. I can confirm that the cells I want to find and clear do contain "No data"

I thought offset could be used to identify the first instance of No data but wouldn't know where to start. Also from what I've read merged cells do cause issues.

Appreciate your help. You little one is more important that this so enjoy your day.

 

[cooper645]

Re: VBA to delete cells

Had a spare bit of time over lunch so here is the code that should do all you wish.

It only throws up an error when there are no cells that contain the string "No data" (Case sensitive).
I can put an error handler in if you wish, but I would rather ensure the code works as it should before adding an error handler.

Sub ClearNoData()

Dim LastCol As Long, LastRow As Long
Dim cell As Range
Dim Rng1 As Range, Rng2 As Range


LastCol = Cells(3, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row


Set Rng1 = Range(Cells(3, 2), Cells(LastRow, LastCol))


Application.ScreenUpdating = False


'Deal with merged
For Each cell In Rng1
    If cell.Value = "No data" Then
        If cell.Offset(-2, 0).MergeCells Then
            cell.Offset(-2, 0).MergeArea.UnMerge
            cell.Offset(-2, 0).ClearContents
        End If
    End If
Next cell
        
'Deal with xx-xx cells
For Each cell In Rng1
    If cell.Value = "No data" Then
            If cell.Offset(-1, 0).Value Like "##[-]##" Then
                cell.Offset(-1, 0).ClearContents
        End If
    End If
Next cell
        
        
'Deal with No data cells
For Each cell In Rng1
If cell.Value = "No data" Then
If Not Rng2 Is Nothing Then
Set Rng2 = Union(Rng2, cell)
Else
Set Rng2 = cell
End If
End If
Next cell


Rng2.ClearContents


Application.ScreenUpdating = True
End Sub

 

[edwardj3]

cooper645

Your solution worked perfectly. I made some slight by using clear instead of ClearContents and I also added a bit more code to remove the borders from the cells after they were unmerged. Not sure if I've done it very efficiently though. The revised code is below. Could I ask for the error handling code. Thanks for all your help. I'm sure I will be able to re-use / re-work this code in other workbooks.

Sub ClearNoData()


Dim LastCol As Long, LastRow As Long
Dim cell As Range
Dim Rng1 As Range, Rng2 As Range




LastCol = Cells(3, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row




Set Rng1 = Range(Cells(3, 2), Cells(LastRow, LastCol))




Application.ScreenUpdating = False




'Deal with merged
For Each cell In Rng1
If cell.Value = "No data" Then
If cell.Offset(-2, 0).MergeCells Then
cell.Offset(-2, 0).MergeArea.UnMerge
cell.Offset(-2, 0).Clear
End If
End If
Next cell


For Each cell In Rng1
If cell.Value = "No data" Then
'If cell.Offset(-2, 0).MergeCells Then
'cell.Offset(-2, 0).MergeArea.UnMerge
cell.Offset(-2, 0).Clear
'End If
End If
Next cell

'Deal with xx-xx cells
For Each cell In Rng1
If cell.Value = "No data" Then
If cell.Offset(-1, 0).Value Like "##[-]##" Then
cell.Offset(-1, 0).Clear
End If
End If
Next cell


'Deal with No data cells
For Each cell In Rng1
If cell.Value = "No data" Then
If Not Rng2 Is Nothing Then
Set Rng2 = Union(Rng2, cell)
Else
Set Rng2 = cell
End If
End If
Next cell




Rng2.Clear




Application.ScreenUpdating = True
End Sub

 

[cooper645]

if your definitely happy the only time you can throw up an error is when there are no cases of 'No data' and it falters at the line of code at the bottom; Rng2.Clear

then add the following line just above it;

On Error Resume Next



Glad to have helped, let me know how you get on.

Coops

 

[edwardj3]

Perfect Coops. Thanks for all your help and advice.

 

[cooper645]

No problem.

Glad to assist, sorry it took so long. Still learning when it comes to VBA