replace many values without a loop

R

robertvdb

Active Member
Joined
Jan 10, 2021
Messages
327
Office Version
  1. 2016
Platform
  1. Windows
I need to replace thousands of values in a column. When I use a loop, it takes too long (ten seconds approx.)

Any alternatives to speed this up ? I use the below code

VBA Code: 
For Each cell In Range("A2:A" & lastRow)
        If cell.Value = 9 Then
            cell.Value = "yes"
        Else
            cell.Value = "no"
        End If
Next cell
 

Attachments

  • replace.png
    replace.png
    17.7 KB · Views: 5

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
Maybe something like:

VBA Code: 
Sub Test()

Dim lRow As Long

With ThisWorkbook.Worksheets("Sheet1")
    lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A2:A" & lRow).Value = .Evaluate("IF(A2:A" & lRow & "=9,""Yes"",""No"")")
End With

End Sub
 
Upvote 0
Below is what I was playing with although I would imagine that @JvdV's option will be faster:
VBA Code: 
Sub test()
    Dim rng As Range
   
    Set rng = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
   
    With rng.Offset(1).Resize(rng.Rows.Count - 1)
        rng.AutoFilter 1, 9
        .SpecialCells(xlCellTypeVisible) = "yes"
        rng.AutoFilter 1, "<>yes"
        .SpecialCells(xlCellTypeVisible) = "no"
        rng.AutoFilter
    End With
End Sub
 
Upvote 0
JvdV said:
Maybe something like:

VBA Code: 
Sub Test()

Dim lRow As Long

With ThisWorkbook.Worksheets("Sheet1")
    lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A2:A" & lRow).Value = .Evaluate("IF(A2:A" & lRow & "=9,""Yes"",""No"")")
End With

End Sub
Click to expand...
thanks for your suggestion, but this does not speed up things... It even takes longer.
 
Upvote 0
Do you have any code at sheet level (worksheet events) that may be firing when you execute the codes above?
 
Upvote 0
robertvdb said:
thanks for your suggestion, but this does not speed up things... It even takes longer.
Click to expand...
That surprises me. I tested both suggestions on 100K rows with 10K 9's and @Georgiboy 's code took less than 0.5 seconds on my laptop, @JdvD 's took less than 0.4 seconds. As well as @Georgiboy 's question above, do you have lots of formulas on the sheet, lots of Conditional Formatting etc.? In any event, you should never loop through cells on a sheet when you have the option of loading them all into an array & looping through that instead. Here's an example (<0.3 seconds with same data sample)

VBA Code: 
Sub test3()
    Application.Calculation = xlManual
    Dim i As Long, a, b, t As Double: t = Timer
    
    a = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        If a(i, 1) = "9" Then b(i, 1) = "Yes" Else b(i, 1) = "No"
    Next i
    Range("A2").Resize(UBound(b, 1)).Value = b
    
    Application.Calculation = xlAutomatic
    MsgBox "That took " & Timer - t & " seconds."
End Sub
 
Upvote 0
Kevin, thanks but it still doesn't make difference (about 1 second faster than the if then else loop. The loop takes 5 seconds).

I will paste my VBA here below, perhaps you can see what I don't see. Some comments are in Dutch, please ignore. The main thing is that you could see things which slow down the whole process.

VBA Code: 
Private Sub cmdClose_Click()

Dim lastRow As Integer
Dim ws As Worksheet
Dim cell As Range
Dim i As Long
Dim a, b As Variant
Dim t As Double: t = Timer

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual


'first deactivate filters
If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilterMode = False
    Range("A2").Select
End If
ActiveWindow.ScrollRow = 1


'then update sheet "export_C"
With Sheets("export_C")
    .Visible = True
    .Select
End With

'STAP 1  HUIDIGE INHOUD VERWIJDEREN
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
If lastRow > 1 Then ws.Rows("2:" & lastRow).Delete

'STAP 2  DE INPUT COPIEREN
With Sheets("input_C")
    .Select
    'eerst voor de werknemer 1
    .Range("A3:A367").Copy  'datums
    Sheets("export_C").Range("C2").PasteSpecial Paste:=xlPasteValues
    
    .Range("F3:F367").Copy  'maanden
    Sheets("export_C").Range("D2").PasteSpecial Paste:=xlPasteValues
    
    .Range("J3:J367").Copy  'effectieve uren
    Sheets("export_C").Range("E2").PasteSpecial Paste:=xlPasteValues
    
    .Range("L3:L367").Copy  'ACERTA UREN
    Sheets("export_C").Range("F2").PasteSpecial Paste:=xlPasteValues
    
    .Range("M3:M367").Copy  '1ste BU
    Sheets("export_C").Range("G2").PasteSpecial Paste:=xlPasteValues
    
    .Range("N3:N367").Copy  '2de BU
    Sheets("export_C").Range("H2").PasteSpecial Paste:=xlPasteValues
    
    .Range("O3:O367").Copy  'overuren
    Sheets("export_C").Range("I2").PasteSpecial Paste:=xlPasteValues
    
    .Range("P3:P367").Copy  'saldo-minuten
    Sheets("export_C").Range("J2").PasteSpecial Paste:=xlPasteValues
        
    .Range("R3:R367").Copy  'annulatie WWV
    Sheets("export_C").Range("K2").PasteSpecial Paste:=xlPasteValues
    
    .Range("S3:S367").Copy  'ziekte
    Sheets("export_C").Range("L2").PasteSpecial Paste:=xlPasteValues
     
    .Range("T3:T367").Copy  'werkloosheid
    Sheets("export_C").Range("M2").PasteSpecial Paste:=xlPasteValues
    
    .Range("U3:U367").Copy  'verlof
    Sheets("export_C").Range("N2").PasteSpecial Paste:=xlPasteValues
    
    .Range("V3:V367").Copy  'klein verlet
    Sheets("export_C").Range("O2").PasteSpecial Paste:=xlPasteValues
    
    .Range("W3:W367").Copy  '4/5
    Sheets("export_C").Range("P2").PasteSpecial Paste:=xlPasteValues
    
    .Range("X3:X367").Copy  'ouderschapsverlof
    Sheets("export_C").Range("Q2").PasteSpecial Paste:=xlPasteValues
    
    .Range("G3:G367").Copy  'aantal werkdagen
    Sheets("export_C").Range("R2").PasteSpecial Paste:=xlPasteValues

    'dan voor werknemer 2 etc
    
    .Range("A3").Select
    Application.CutCopyMode = False
End With

With Sheets("export_C")
    .Select
    .Range("A2:A366").Value = "chauffeurs"
    .Range("B2:B366").Value = WorksheetFunction.Proper(Sheets("input_C").Range("G1").Value)
    ''hier aanvullen voor andere chauffeurs
    '.Range("A367:A731").Value = "magazijniers"
    '.Range("B367:B731").Value = WorksheetFunction.Proper(Sheets("input_C").Range("xxxxW1").Value)
    
    a = .Range("R2:R" & .Range("A" & .Rows.Count).End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        If a(i, 1) = "aanwezig" Then b(i, 1) = 1 Else b(i, 1) = 0
    Next i
    .Range("R2").Resize(UBound(b, 1)).Value = b
    
    
.Range("A2").Select
End With
Application.Calculation = xlAutomatic
Application.EnableEvents = True




With Sheets("intro")
.Visible = True
.Select
End With

Sheets("input_C").Visible = False
Sheets("export_C").Visible = False

Application.ScreenUpdating = True

MsgBox "That took " & Timer - t & " seconds."

End Sub
 
Upvote 0
Perhaps removing the Sheet.Select lines and also removing some of the copy/paste bits:
VBA Code: 
Private Sub cmdClose_Click()
    Dim lastRow As Integer
    Dim ws As Worksheet
    Dim cell As Range
    Dim i As Long
    Dim a, b As Variant
    Dim t As Double: t = Timer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlManual
    
    'first deactivate filters
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
    
    'then update sheet "export_C"
    With Sheets("export_C")
        .Visible = True
    End With
    
    'STAP 1  HUIDIGE INHOUD VERWIJDEREN
    Set ws = Sheets("export_C")
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    If lastRow > 1 Then ws.Rows("2:" & lastRow).Delete
    
    'STAP 2  DE INPUT COPIEREN
    With Sheets("input_C")
        'eerst voor de werknemer 1
        .Range("A3:A367,F3:F367,J3:J367,L3:P367,R3:X367,G3:G367").Copy  'datums
        Sheets("export_C").Range("C2").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
    
    With Sheets("export_C")
        .Select
        .Range("A2:A366").Value = "chauffeurs"
        .Range("B2:B366").Value = WorksheetFunction.Proper(Sheets("input_C").Range("G1").Value)
        a = .Range("R2:R" & .Range("A" & .Rows.Count).End(xlUp).Row)
        ReDim b(1 To UBound(a, 1), 1 To 1)
        For i = 1 To UBound(a, 1)
            If a(i, 1) = "aanwezig" Then b(i, 1) = 1 Else b(i, 1) = 0
        Next i
        .Range("R2").Resize(UBound(b, 1)).Value = b
    End With
    
    Application.Calculation = xlAutomatic
    Application.EnableEvents = True
    
    With Sheets("intro")
        .Visible = True
        .Select
    End With
    
    Sheets("input_C").Visible = False
    Sheets("export_C").Visible = False
    
    Application.ScreenUpdating = True
    
    MsgBox "That took " & Timer - t & " seconds."
End Sub
 
Upvote 0
Georgiboy said:
Perhaps removing the Sheet.Select lines and also removing some of the copy/paste bits:
VBA Code: 
Private Sub cmdClose_Click()
    Dim lastRow As Integer
    Dim ws As Worksheet
    Dim cell As Range
    Dim i As Long
    Dim a, b As Variant
    Dim t As Double: t = Timer
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlManual
   
    'first deactivate filters
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
   
    'then update sheet "export_C"
    With Sheets("export_C")
        .Visible = True
    End With
   
    'STAP 1  HUIDIGE INHOUD VERWIJDEREN
    Set ws = Sheets("export_C")
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    If lastRow > 1 Then ws.Rows("2:" & lastRow).Delete
   
    'STAP 2  DE INPUT COPIEREN
    With Sheets("input_C")
        'eerst voor de werknemer 1
        .Range("A3:A367,F3:F367,J3:J367,L3:P367,R3:X367,G3:G367").Copy  'datums
        Sheets("export_C").Range("C2").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
   
    With Sheets("export_C")
        .Select
        .Range("A2:A366").Value = "chauffeurs"
        .Range("B2:B366").Value = WorksheetFunction.Proper(Sheets("input_C").Range("G1").Value)
        a = .Range("R2:R" & .Range("A" & .Rows.Count).End(xlUp).Row)
        ReDim b(1 To UBound(a, 1), 1 To 1)
        For i = 1 To UBound(a, 1)
            If a(i, 1) = "aanwezig" Then b(i, 1) = 1 Else b(i, 1) = 0
        Next i
        .Range("R2").Resize(UBound(b, 1)).Value = b
    End With
   
    Application.Calculation = xlAutomatic
    Application.EnableEvents = True
   
    With Sheets("intro")
        .Visible = True
        .Select
    End With
   
    Sheets("input_C").Visible = False
    Sheets("export_C").Visible = False
   
    Application.ScreenUpdating = True
   
    MsgBox "That took " & Timer - t & " seconds."
End Sub
Click to expand...
that's one step in the right direction... saves me half a second :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Vba code to find and replace in excel closed workbooks.
Replies
1
Views
347
6StringJazzer
6StringJazzer
F
  • Question
No cells were found - trying to copy a hidden row range
Replies
3
Views
55
Micron
M
P
  • Question
How to pass variable between subs that are stored as array element through CreateObject("Scripting.Dictionary")
Replies
1
Views
73
Micron
M
S
  • Question
CSV export to remove column
Replies
1
Views
88
StellarRumble59
S
C
  • Question
Finding any two values in each cell text in a column of cells with both values as one Textbox1 variable
2
Replies
10
Views
227
chazrab
C

Forum statistics

Threads
1,214,927
Messages
6,122,309
Members
449,080
Latest member
jmsotelo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top