Trying to clear contents in multiple cells based on a calculation in another cell.

[spittingfire]

Hi All,

I am not sure if what I want to achieve is possible or not but I won't know unless I ask

I have data in cells A5:J5

Cells G5 has a start time and H5 has the stop time.

What I want to do is in N5 is write a formula that if H5 is less than G5 then clear the contents of A5:J5. If it is not then leave as is (do nothing).

If no such formula exists is there a way to do it via VB?

Thanks in advance for all your help.

 

[Joyner]

What you are trying to do is not possible with a formula if the data in columns A through J are "raw"/hard coded data. If the data in those cells are based on a formula, then you can modify the formula to do what you want. If you want to use a formula, you can if you use helper columns - those would be something like:

=IF(H5<G5,"",A5) , one for each column. You can hide the original data if you want.

If you can't use helper columns, then VBA will be the only way to go. I am not a VBA expert, but that code would be straight forward - I think something like this

IF H5 < G5 Then
Range("A5:J5").CleanContents
End If

If you need to loop through the entire column that can be done easily also, but the VBA experts will know, or I can write and test if you need.

 

[spittingfire]

Thanks Joyner for your reply.

Yes I will love your assistance to help build me build a vb script and yes I will need it to loop through about 500 rows.

Thanks again for your help.

 

[Joyner]

Hello Try this - always try on a copy of your data:

If you don't know how to save or run the macro, let me know

[code:]
Sub ClearRange()

Dim myLastRow As Long
Dim i As Long

Application.ScreenUpdating = False

' Find last row
myLastRow = Cells(Rows.Count, "G").End(xlUp).Row

' Loop through range
For i = 5 To myLastRow
If Cells(i, "H").Value < Cells(i, "G").Value Then Range(Cells(i, "A"), Cells(i, "J")).ClearContents
Next i

Application.ScreenUpdating = True

End Sub
[code:]

 

[Peter_SSs]

For a non-looping approach you could also try this.
It assumes K1:K2 are empty. If not, change the Set rCrit line to any column that will be empty.

Sub CheckAndClear()
  Dim rCrit As Range
  
  Set rCrit = Range("K1:K2")
  Application.ScreenUpdating = False
  rCrit.Cells(2).Formula = "=H2<G2"
  With Range("A1:J" & Range("A" & Rows.Count).End(xlUp).Row)
    .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
    .Offset(1).SpecialCells(xlVisible).ClearContents
  End With
  If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
  rCrit.ClearContents
  Application.ScreenUpdating = True
End Sub

 

[spittingfire]

Thanks a million Joyner,

That works very well, however I just realized that I still need to inspect the data that is being cleared.

Is it too much trouble to have the script modified to first copy the those troubled data (A:J) to sheet 2 before clearing the contents?

thanks again and sorry for the trouble

 

[spittingfire]

Thanks as well for you assistance Perter. That option works as well for me, however I know noticed that I will want to capture this data another sheet (Sheet2) before clearing the contents.

Is it possible for you to modify your code to accommodate that?

Thanks in advance

 

[Peter_SSs]

Thanks as well for you assistance Perter. That option works as well for me, however I know noticed that I will want to capture this data another sheet (Sheet2) before clearing the contents.

Is it possible for you to modify your code to accommodate that?

Sure.

The following code assumes that Sheet2 already exists and any data already on it can be cleared. If that is not the case then please give more details about it.
I don't know what the name of the sheet with the main data is. My code uses 'Sheet1' for that sheet name. Alter the code if needed to match your sheet name.

Sub CheckAndClear()
  Dim rCrit As Range
  
  Sheets("Sheet2").UsedRange.ClearContents
  With Sheets("Sheet1")                   '<- Change to your sheet name
    Set rCrit = .Range("K1:K2")
    Application.ScreenUpdating = False
    rCrit.Cells(2).Formula = "=H2<G2"
    With .Range("A1:J" & .Range("A" & Rows.Count).End(xlUp).Row)
      .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Sheets("Sheet2").Range("A1"), Unique:=False
      .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
      .Offset(1).SpecialCells(xlVisible).ClearContents
    End With
    If .FilterMode Then .ShowAllData
  End With
  rCrit.ClearContents
  Application.ScreenUpdating = True
End Sub

 

[spittingfire]

Thanks Peter,

That worked well after making some small changes at the sheets named differently

 

[Peter_SSs]

Thanks Peter,

That worked well after making some small changes at the sheets named differently

That's good, thanks for letting us know.