Thread: Performance issue - Looping through Cells

I have a failry complex application that involves data transfer between two separate WorkBooks.

The application works perfectly however, I do have a performance issue that I am hoping to solve. I did extensive debugging and tracing to isolate the portion of the code that was bogging down. I then read extensively on the symtpoms and learned that the cause was likely do to the "For Each ... Next" construct I was using to loop through the cells.

Dim rCell As Range, rMultipleColumns As Range
Dim sCellFormat as String
Dim vCellValue as Variant

'--- I've skipped all the other code in between here

'Loop through each cell in pre-defined multi-column range
For Each rCell In rMultipleColumns
    If VarType(rCell) <> vbDate Then   'Do not re-format dates ... they process correctly as-is
        vCellValue = rCell.value   'Get value of current cell
        sCellFormat = rCell.NumberFormat
        If Right(sCellFormat, 1) = "%" Then   'Need to re-format cells that are formatted as a percentage
            rCell.value = "'" & Format(vCellValue, sCellFormat)
        Else   'Otherwise, format the cell as text
            rCell.NumberFormat = "@"
        End If
    End If
Next rCell

One possible solution I located involved a method whereby the Range "value" is first copied to an array, processed quickly, then copied back to the range. I wasn't able to figure out how to implement that method with the "numberformat" property though which is necessary in my logic above. In case it helps, here is the "copy to an array" method which runs exceedingly fast:

Dim lCurrentCell as Long
Dim rSelectedColumn as Range
Dim vTempRange as Variant

'--- I've skipped all the other code in between here

vTempRange = rSelectedColumn.value   'Copy range to array
    
For lCurrentCell = LBound(vTempRange) To UBound(vTempRange)
    Select Case Nz(Trim(vTempRange(lCurrentCell, 1)), "")
    Case "N", "Y"   'Value already set as 'N' or 'Y' - leave it alone
    Case Else   'Blank, space or null ... set to default of 'N'
        vTempRange(lCurrentCell, 1) = "N"
    End Select
Next lCurrentCell

rSelectedColumn.value = cTempRange   'Now, copy the array back to the range

Thank you for anything you can offer.

Doug