2

I'm currently using this code to convert a large number of cells containing decimal numbers stored as text to decimal numbers:

For Each ws In Sheets
    On Error Resume Next
    For Each r In ws.UsedRange.SpecialCells(xlCellTypeConstants)
        If IsNumeric(r) Then r.Value = CDbl(r.Value)
    Next
Next

This operation runs pretty slow and I'd like it to run faster if possible.

I'm a beginner at this and the code displayed above is collected through google. Is it possible to make this operation go faster through editing the code or using a different code?

Community
  • 1
  • 1

5 Answers5

2

Try this. This uses Array to do the entire operation. This is very fast as compared to looping through every range.

Logic:

  1. Loop through the sheets and find the last row and last column
  2. Identify the range instead of using UsedRange blindly. You may want to see THIS
  3. Copy that data into array
  4. Clearing the Sheet - Resets the format of the sheet to General. Hope you have no other formatting in the sheet? If you have then see second piece of code.
  5. Paste the data back to the sheet.

Code

Sub Sample()
    Dim ws As Worksheet
    Dim usdRng As Range
    Dim lastrow As Long, lastcol As Long
    Dim myAr

    For Each ws In Sheets
        With ws
            '~~> Check if sheet has any data
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                '~~> Find Last Row
                lastrow = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row

                '~~> Find last column
                lastcol = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column

                '~~> Set your range here
                Set usdRng = .Range("A1:" & _
                Split(.Cells(, lastcol).Address, "$")(1) & lastrow)

                '~~> Write to array
                myAr = usdRng.Value

                '~~> Clear the sheet
                .Cells.Clear

                '~~> Write back to the sheet
                .Range("A1").Resize(lastrow, lastcol).Value = myAr
            End If
        End With
    Next
End Sub

ScreenShot

enter image description here

EDIT

If you have other formats in the sheet then use this

Sub Sample()
    Dim ws As Worksheet
    Dim usdRng As Range, rng as Range
    Dim lastrow As Long, lastcol As Long
    Dim myAr

    For Each ws In Sheets
        With ws
            '~~> Check if sheet has any data
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                '~~> Find Last Row
                lastrow = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row

                '~~> Find last column
                lastcol = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column

                '~~> Set your range here
                Set usdRng = .Range("A1:" & _
                Split(.Cells(, lastcol).Address, "$")(1) & lastrow)

                On Error Resume Next
                Set rng = usdRng.SpecialCells(xlCellTypeConstants)
                On Error GoTo 0

                If Not rng Is Nothing Then
                    '~~> Write to array
                    myAr = usdRng.Value

                    '~~> Clear the Range
                    rng.NumberFormat = "0.00"
                    Set rng = Nothing

                    '~~> Clear contents of the sheet
                    usdRng.ClearContents

                    '~~> Write back to the sheet
                    .Range("A1").Resize(lastrow, lastcol).Value = myAr
                End If
            End If
        End With
    Next
End Sub

Screenshot

enter image description here

Community
  • 1
  • 1
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • Might be a stupid question, but will this loop through each sheet in a workbook and convert everything to numbers, and thereby swapping formulas to number? How can the code be changed to run in only a selected sheet, in this case "Import"? – Morten Martinsen Sep 18 '15 at 07:34
  • 1
    Yes this will loop through every sheet and convert numbers stored as text to numbers. Yes also it will convert formulas to text/numbers. To make it work for "Import" Sheet, remove the `For` loop and before the `With Ws` add a line `Set ws = thisworkbook.sheets("Import")` – Siddharth Rout Sep 18 '15 at 07:39
  • It does'nt seem to convert decimal text to numbers in my case. I've uploaded a file to dropbox so you can check out the setup. https://www.dropbox.com/s/sntvcxpw5ntwc6f/test.xlsm?dl=0 It seems it has converted the format of the cells to "Number" but the numbers themselves stay as text after the script has run. – Morten Martinsen Sep 18 '15 at 09:30
  • Do you have `,` as your decimal operator? – Siddharth Rout Sep 18 '15 at 11:24
  • Yes, comma is decimal operator. Tried swapping out "0.00" to "0,00" with no effect. – Morten Martinsen Sep 18 '15 at 11:37
  • when i replace "," with `.`, it worked as I wanted it – Siddharth Rout Sep 18 '15 at 11:46
  • It worked in the file I linked in the comment above? When I change rng.NumberFormat = "0.00" to "0,00" it still stays as text. – Morten Martinsen Sep 18 '15 at 11:57
  • Yes it worked on the file linked in the comment above. BTW I replaced all `,` with `.` – Siddharth Rout Sep 18 '15 at 12:01
  • Did you do a search and replace in the dataset? Isn't it possible to do a change in code to make it work automatically? – Morten Martinsen Sep 18 '15 at 12:30
1

Depending on your contents, you can quickly save some processing using

For Each r In ws.UsedRange.SpecialCells(xlCellTypeConstants,xlTextValues)

Alternatively, move the range (or part of it if really big) into an array, (using myArray=range("b2:x200")), then process the array and rewrite it at once. This is much faster because in your sample the slow part is in fact the interaction between VBA and the cells.

Sub test()
    Dim src As Range
    Dim ar As Variant
    Dim r As Long, c As Long

    Set src = Range("b2").CurrentRegion
    ar = src    'move ange into array
    For r = 1 To UBound(ar, 1)
        For c = 1 To UBound(ar, 2)
            If VarType(ar(r, c)) = 8 Then 'string
                If IsNumeric(ar(r, c)) Then
                    ar(r, c) = CDbl(ar(r, c))
                End If
            End If
        Next c
    Next r
    src = ar    'write array back to sheet
End Sub
iDevlop
  • 24,841
  • 11
  • 90
  • 149
1

Two other options, no VBA:

  1. Turn on Error Checking if off, select the appropriate range, click the !, click Convert to Number.

  2. Enter 1 in a cell, select and copy it. Select the appropriate range, Paste Special..., Operation multiply. (Will convert blank cells to 0.)

pnuts
  • 58,317
  • 11
  • 87
  • 139
  • I would be using that if this was supposed to be manual labor. I'm creating a workbook that collects data from another workbook and process that data, including converting text to number. – Morten Martinsen Sep 18 '15 at 07:07
0

turn the UI off and on.

'turn off UI
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.Calculation = xlManual

--- your code here

'turn on UI
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic
psychicebola
  • 939
  • 1
  • 8
  • 16
  • No that will not make a difference. The code will still loop through cells which will make it slow :) – Siddharth Rout Sep 17 '15 at 07:30
  • I know, but it was the fastest solution I had so far ;-) I also use this code and in my cases it improves the performances a lot. – psychicebola Sep 17 '15 at 07:36
  • In your case it may have helped because you had a very small dataset :) Try creating an excel file with 50k Rows and 1k Columns and then tell me how much time did it take. Your code will loop through `50000 X 1000 = 50,000,000` cells if all had numbers stored as text. Anyways, I leave the decision with you ;) – Siddharth Rout Sep 17 '15 at 07:43
  • well at some point it is useful to move the excel macro to a database ;) – psychicebola Sep 17 '15 at 08:06
0

My version - Set the range using your preferred option - I've just gone with UsedRange here, but would be better to use FIND (Siddharths code uses this).

I place the number 1 into a blank cell (I've used the last cell on the sheet), copy that number and paste special and multiply - any numbers will be multiplied by 1 and return a number, any text remains as

Sub TurnToNumbers()

    Dim rng As Range

    With Worksheets("Sheet1")
        Set rng = .UsedRange.SpecialCells(xlCellTypeConstants)

        'Place 1 into an empty cell, copy it and pastespecial and multiply.
        .Cells(Rows.Count, 1) = 1
        .Cells(Rows.Count, 1).Copy
        rng.PasteSpecial Operation:=xlPasteSpecialOperationMultiply
        .Cells(Rows.Count, 1).ClearContents
    End With

End Sub
Darren Bartrup-Cook
  • 18,362
  • 1
  • 23
  • 45