VBA loop to search 100,000s of cells to modify and replace taking too long.

[axonjacksn]

Hi, first time poster here.

I'm working on parsing iostat information (it's a unix command to get disk information). It provides disk information in bytes, but when it gets to 1000 bytes it changes it to KB. For example, I'll have a data point that says 900 which mean 900 bytes and then another data point that says 1.1K which is 1100 bytes. Excel doesn't understand what the "K" means so I have to do a search for all cells that have a number followed by a "K" and then strip the "." and "K" out and add two zeros so that I have an actual number.

My issue is that the code I have in VBA is taking a long time to execute. When I have a large file (60,000 lines) there are over 20,000 instances with "K." The code runs an average of 565 "K" replacements per minute which will translate this to about 35 minutes to complete.

I don't have a lot of experience coding VBA so I did a mishmash of macro recording and things I found online.

Can someone let me know how I can optimize my code to do a faster search/modify/replace?

Thanks!

Here is my code:

Sub find_ks()
'
' find_ks Macro
'

Dim cellvalue As String
Dim cellsmallvalue As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Do While 1 = 1


    Columns("C:Z").Select
    Selection.Find(What:="K", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    cellvalue = ActiveCell.Value ' sets cell value to variable
    cellsmallvalue = Right(cellvalue, 2) 'Pull the right two characters
    cellsmallvalue = Left(cellsmallvalue, Len(cellsmallvalue) - 1) 'removes the last character "K"
    cellvalue = Left(cellvalue, Len(cellvalue) - 3) ' removes last 3 characters from string
    cellvalue = cellvalue & cellsmallvalue & "00" '3800
    ActiveCell.FormulaR1C1 = cellvalue 'set value

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

 

[Jerry Sullivan]

Hello and Welcome,

This should run quite a bit faster...

Sub Replace_Ks()
    Dim i As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For i = 0 To 9
        Range("C:Z").Replace What:="." & i & "K", Replacement:=i & "00", _
            LookAt:=xlPart, MatchCase:=False
    Next i
    Application.Calculation = xlCalculationAutomatic
End Sub

How is 2000 bytes listed? If it is shown as 2.0K the above code should work as is.
If it is shown as 2K then you would modify the code slightly...

Sub Replace_Ks()
    Dim i As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For i = 1 To 9
        Range("C:Z").Replace What:="." & i & "K", Replacement:=i & "00", _
            LookAt:=xlPart, MatchCase:=False
    Next i
    Range("C:Z").Replace What:="K", Replacement:="000", _
           LookAt:=xlPart, MatchCase:=False 
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[axonjacksn]

Your code worked beautifully! Times to find/replace went from 20 minutes to about 10 seconds!

Thanks for your help!

 

[John Davis]

Hi, first time poster here.

I'm working on parsing iostat information (it's a unix command to get disk information). It provides disk information in bytes, but when it gets to 1000 bytes it changes it to KB. For example, I'll have a data point that says 900 which mean 900 bytes and then another data point that says 1.1K which is 1100 bytes. Excel doesn't understand what the "K" means so I have to do a search for all cells that have a number followed by a "K" and then strip the "." and "K" out and add two zeros so that I have an actual number.

My issue is that the code I have in VBA is taking a long time to execute. When I have a large file (60,000 lines) there are over 20,000 instances with "K." The code runs an average of 565 "K" replacements per minute which will translate this to about 35 minutes to complete.

I don't have a lot of experience coding VBA so I did a mishmash of macro recording and things I found online.

Can someone let me know how I can optimize my code to do a faster search/modify/replace?

Thanks!

Here is my code:

Sub find_ks()
'
' find_ks Macro
'

Dim cellvalue As String
Dim cellsmallvalue As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Do While 1 = 1


    Columns("C:Z").Select
    Selection.Find(What:="K", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    cellvalue = ActiveCell.Value ' sets cell value to variable
    cellsmallvalue = Right(cellvalue, 2) 'Pull the right two characters
    cellsmallvalue = Left(cellsmallvalue, Len(cellsmallvalue) - 1) 'removes the last character "K"
    cellvalue = Left(cellvalue, Len(cellvalue) - 3) ' removes last 3 characters from string
    cellvalue = cellvalue & cellsmallvalue & "00" '3800
    ActiveCell.FormulaR1C1 = cellvalue 'set value

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

Here's my 2 cents:

Sub axonjacksn()
'
Dim lr As Long

Dim x As Long


Application.ScreenUpdating = False

On Error Resume Next

For x = 3 To 24

lr = Cells(Rows.Count, 3).End(3).Row

'
With Range(Cells(2, x), Cells(lr, x))
    
    .AutoFilter Field:=1, Criteria1:="=*K", Operator:=xlAnd
    .SpecialCells (xlCellTypeVisible)
    .Replace What:="K", Replacement:=".00"
    .Replace What:=".", Replacement:=""
    .AutoFilter
    
End With

Next x

Application.ScreenUpdating = True

End Sub