vba macro for Replace Negative value with specific Numbers in Excel sheet specific column.

[BINOD SHARMA]

Dear all, i am new in Excel VBA . A specific Excel Sheet Column range value having some Negative Numbers. I want to Replace with a certain value like " 5000" by VBA code.
I run the following vba macro for the same purpose, but it's work very slow. My column row range length are almost 65,000 rows.
My using code is -
Dim ws As Worksheet
Dim i As Variant
Set ws = Worksheets("DEPSHADO")
'convert negative numbers to positive
For i = 3 To 65000
If ws.Range("D" & i) <> "" Then
If ws.Range("D" & i).Value < 0 Then
ws.Range("E" & i).Value = 5100
End If
End If
Next i

It's run very slow as 120 seconds. Kind advise a suitable VBA macro to perform faster.

Regards

BINOD SHARMA

 

[jxb]

What does the following do?
If ws.Range("D" & i) <> "" then

Would the following be faster ?

Dim cell as range
For each cell in ws.range(d3:d65000)
If cell.value<0 then cells(cell.row,5).value =5100
Next cell

 

[Fluff]

How about

Sub BinodSharma()
   With Worksheets("DEPSHADO")
      With .Range("E3:E" & .Range("D" & Rows.Count).End(xlUp).Row)
         .Value = Evaluate(Replace("if(@="""","""",if(@<0,5100,""""))", "@", .Offset(, -1).Address))
      End With
   End With
End Sub

 

[lrobbo314]

I would guess that Fluff's will be fastest, but here's another VBA loop solution to consider.

Sub Faster()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim ws As Worksheet:    Set ws = Worksheets("DEPSHADO")
Dim r As Range:         Set r = ws.Range("D3:D" & ws.Range("D" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2

For i = 1 To UBound(AR)
    If AR(i, 1) < 0 Then AR(i, 1) = 5100
Next i

With r
    .ClearContents
    .Value = AR
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[BINOD SHARMA]

I would guess that Fluff's will be fastest, but here's another VBA loop solution to consider.

Sub Faster()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim ws As Worksheet:    Set ws = Worksheets("DEPSHADO")
Dim r As Range:         Set r = ws.Range("D3:D" & ws.Range("D" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2

For i = 1 To UBound(AR)
    If AR(i, 1) < 0 Then AR(i, 1) = 5100
Next i

With r
    .ClearContents
    .Value = AR
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

Thank you sir, the macro is work like a champ, very fast but it's not work for me. My requirement is the macro code will validate (Follow) Negative numbers value of "D" Column and Replace with 5100 in " E" column existing any value ( That have no negative value).
Kindly make necessary changes in your code as per my concern.

Regards,
Binod Sharma

 

[BINOD SHARMA]

How about

Sub BinodSharma()
   With Worksheets("DEPSHADO")
      With .Range("E3:E" & .Range("D" & Rows.Count).End(xlUp).Row)
         .Value = Evaluate(Replace("if(@="""","""",if(@<0,5100,""""))", "@", .Offset(, -1).Address))
      End With
   End With
End Sub

Thank you sir for quick response,
for your kind information your code is as fast as mine. It's takes 121 seconds to update my sheet.
Please write a different code pattern as array.

Regards,
B SHARMA

 

[BINOD SHARMA]

Thank you sir for quick response,
for your kind information your code is as fast as mine. It's takes 121 seconds to update my sheet.
Please write a different code pattern as array.

Regards,
B SHARMA

 

[Fluff]

There is no way the code I supplied will take as long as your looping code, unless you have something else going on.
Try it like

Sub BinodSharma()
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With
   With Worksheets("DEPSHADO")
      With .Range("E3:E" & .Range("D" & Rows.Count).End(xlUp).Row)
         .Value = Evaluate(Replace("if(@="""","""",if(@<0,5100,""""))", "@", .Offset(, -1).Address))
      End With
   End With
   With Application
      .EnableEvents = True
      .Calculation = xlCalculationAutomatic
   End With
End Sub

 

[jxb]

Just a thought.
Would it save time to sort column D (small to large) so that the negative numbers are at the "beginning" and then use a While loop?

While cell.value <0  cells(cell.row,5).value =5100

thus the macro would not deal with potentially a very large number of rows (stops once the numbers are positive!)