Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Access VBA - faster way to change Excel cell values across a large range?

I have a bit of VBA code in Access that gets a range of cells from an Excel worksheet, and then converts them from a number to a date. A range, for example, would be H1:Y25000

Public Sub FixDates(theRange as Range)

Dim RangeCell as Range

For Each RangeCell In theRange
    If IsNumeric(RangeCell.Value) And RangeCell.Value > 0 And Not IsEmpty(RangeCell.Value) Then
        lngDate = CLng(RangeCell.Value)
        RangeCell.Value = DateAdd("d", lngDate -1, "1/1/1968")
    End If
Next RangeCell

End Sub

The code seems to work but it takes an awful long time to run. Can this be written differently to run faster? I was reading about using Variant instead of Range, but I can't figure it out.

Oh, to call the Sub, I use something like:

path = "C:\myfile.xlsx"
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Open(path)
Set xlWks = xlWbk.Worksheets(1)
lastRow = xlWks.Range("A1").End(xlDown).Row
FixDates (xlWks.Range("H1:Y" & lastRow))

Thanks!

like image 350
Jeff Brady Avatar asked Apr 19 '13 17:04

Jeff Brady


1 Answers

You can simply assign the range to a variant, which will create an array - it would look like the code below - you should add appropriate error handling:

Public Sub FixDates(theRange as Range)

    Dim data as Variant
    Dim i as Long
    Dim j as Long
    Dim lngDate as Long

    data = theRange

    For i = LBound(data, 1) to UBound(data, 1)
        For j = LBound(data, 2) to UBound(data, 2)
            If IsNumeric(data(i, j)) Then
                If data(i, j) > 0 Then
                    lngDate = CLng(data(i, j))
                    data(i, j) = DateAdd("d", lngDate - 1, "1/1/1968")
                End If
            End If
        Next j
    Next i

    theRange = data

End Sub
like image 108
assylias Avatar answered Oct 05 '22 00:10

assylias