How to Check Value of Cells in Range VBA - vba

Question

I am trying to take a range of cells (column B to be specific) and find the cells in that range that have a value less than zero and clear the contents of those cells. Is there a way to do this without looping through every single cell? The column is a very large data set that gets longer each week so looping takes a significant amount of time.
Below is the current loop I am using
Dim sht As Worksheet
Dim LastColumn As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
lastrow = sht.Cells.Find("*", SearchOrder:=xlByRows,
searchdirection:=xlPrevious).Row
for i=1 to lastrow
if sheets("time").cells(i, "B") then
sheets("time").cells(i, "B").clear
end if
next i
The cells I am trying to examine and then potentially delete contain formulas
edit: The answer marked as accepted sped up the process but still requires a loop. If anyone has anything that would be faster than what is posted feel free to add it.

Answer 1

As per my comment. I run this on 50k rows, took minor amounts of time.
Option Explicit
Sub update_column()
Dim Column_to_run_on As String
Dim LR As Long, i As Long
Dim arr As Variant
'change as needed
Column_to_run_on = "D"
'change sheet as needed
With Sheets("Sheet1")
LR = .Range(Column_to_run_on & "1048575").End(xlUp).Row
'"2:" here as I assume you have a header row so need to start from row 2
arr = .Range(Column_to_run_on & "2:" & Column_to_run_on & LR)
For i = 1 To UBound(arr, 1)
If arr(i, 1) < 0 Then
arr(i, 1) = 0
End If
Next
.Range(Column_to_run_on & "2:" & Column_to_run_on & LR).Value = arr
End With
End Sub

Answer 2

No loop is needed. Say we have data in B1 through B21 like:
This tiny macro:
Sub RemoveNegs()
With Range("B1:B21")
.Value = Evaluate("IF(" & .Address & " < 0,""""," & .Address & ")")
End With
End Sub
will produce:
Not appropriate if the cells contain formulas.

Answer 3

i tested lopps with vba array against both solutions, loops is at least 2 to 5 times faster in each case:
Option Explicit
Sub fill()
Dim t As Double
t = Timer
Dim x&
Dim y&
Dim arr()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
ReDim arr(1 To 2000, 1 To 1000)
For x = 1 To 1000
For y = 1 To 2000
arr(y, x) = Rnd() * 1111 - 555
Next y
Next x
Range(Cells(1, 1), Cells(2000, 1000)).Value2 = arr
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
Debug.Print Timer - t
End With
Erase arr
End Sub
Sub nega()
Dim t As Double
t = Timer
Dim x&
Dim y&
Dim arr()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
'With Range("A1", Cells(2000, 1000))
' .Value2 = Evaluate("if(" & .Address & " <0,""""," & .Address & ")")
'End With
'Range(Cells(1, 1), Cells(2000, 1000)).Replace "-*", ""
arr = Range(Cells(1, 1), Cells(2000, 1000)).Value2
For x = 1 To 1000
For y = 1 To 2000
If arr(y, x) < 0 Then arr(y, x) = vbNullString
Next y
Next x
Range(Cells(1, 1), Cells(2000, 1000)).Value2 = arr
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Erase arr
Debug.Print Timer - t
End Sub