CODEWITHSUNDEEP
vbaexcel
Mo2
Mo2

Reputation: 1131

Alternate to Replace function cell by cell - VBA

I currently have a few dozen columns with hundreds of rows for each. One of the subs that I am calling goes and modifies the data of the cells after it comes in from an XML hosted on the web. The current method works, but it tends to get a bit slow since it does the changes cell by cell. Here is my code:

Private Sub fixEnt(listCol As ListColumn) 'fixes the HTML/XML entities
    Dim rng As Range
    On Error Resume Next
    Set rng = listCol.DataBodyRange.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    If Not rng Is Nothing Then
        For Each areaItem In rng.Areas 'iterate over the arrays in the Areas array
            For Each cell In areaItem 'iterate over the values in the Item array
                cell.Value = decodeEnt(cell.Value)
            Next
        Next
    End If
End Sub

which calls on decodeEnt:

Private Function decodeEnt(cellVal As String) As String

    Dim tempStr$ 'holds new value after replace
    tempStr = Replace(cellVal, """, Chr(34)) 'Chr(34) is a "
    tempStr = Replace(tempStr, "'", "'")
    tempStr = Replace(tempStr, "&", "&")
    tempStr = Replace(tempStr, "&#60;", "<")
    tempStr = Replace(tempStr, "&#62;", ">")
    tempStr = Replace(tempStr, "&#160;", " ")
    tempStr = Replace(tempStr, "&#35;", "#")
    tempStr = Replace(tempStr, "&nbsp;", " ")
    tempStr = Replace(tempStr, "&lt;", "<")
    tempStr = Replace(tempStr, "&gt;", ">")
    tempStr = Replace(tempStr, "&quot;", Chr(34))
    tempStr = Replace(tempStr, "&apos;", "'")
    tempStr = Replace(tempStr, "&amp;", "&")
    tempStr = Replace(tempStr, "&ndash;", "–")
    tempStr = Replace(tempStr, "&#252;", "ü")
    tempStr = Replace(tempStr, "&deg;", "°")
    tempStr = Replace(tempStr, "&auml;", "ä")
    tempStr = Replace(tempStr, "&uuml;", "ü")
    tempStr = Replace(tempStr, "&rsquo;", "’")

    decodeEnt = tempStr 'Return modified string
End Function

Is there a quicker way of performing that operation? Something that modifies the data all at once in the rng.Areas array perhaps? Speed is key for this project, but I'm out of ideas in this case.

Thanks

EDIT: To further clarify about the project. It imports an XML file from an API of another tool and saves it into a table in Excel. I have other code that refreshes the connection, appends all data from the XML (new and old). Once the refresh process is complete it begins the data modification which include fixing the HTML/XML entities in the cells and fixing the format for dates. After the modifications are done, , it removes duplicate rows (since there is no way of adding only new data when doing a refresh).

Hope this clears up any confusion.

Upvotes: 0

Views: 1481

Answers (2)

Siphor
Siphor

Reputation: 2534

there is a replace function for ranges which may be faster.

for general performance tips (especially ScreenUpdating, Calculation and "Read/Write Large Blocks of Cells in a Single Operation"):

http://blogs.office.com/2009/03/12/excel-vba-performance-coding-best-practices/

(In my experience the main things that help are deactivating Application.ScreenUpdating, deactivating Application.Calculation or Read/Write Large Blocks of Cells in a Single Operation)

Upvotes: 1

Floris
Floris

Reputation: 46375

I suspect the following would be much faster (doing all cells at once):

Sub test()
    Dim replaceThis()
    Dim withThis()
    replaceThis = Array("&lt;", "&gt;") ' etc
    withThis = Array("<", ">") ' etc

    Application.ScreenUpdating = False
    For i = LBound(replaceThis) To UBound(replaceThis)
      'MsgBox "replacing " & replaceThis(i) & " with " & withThis(i)
      Range("A1:A5").Replace What:=replaceThis(i), Replacement:=withThis(i), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    Next i
    Application.ScreenUpdating = True
End Sub

Note - you will want to create an array containing all your substitutions, and I hard coded the range: you need to make that variable. But seeing your code, I think you can figure it out from here.

Upvotes: 1

Related Questions