Jonas
Jonas

Reputation: 23

VBA Concatenating / using Format takes too long

I want to loop through a column in a range and concatenate a date and a number to generate kind of an ID. The problem is: The cell that includes the date also includes the time, for now i use Format(datum.Cells(1, 1), "dd/mm/yyyy"), this however takes ages to process. Is there any way to speed that up?

For Each datum In Range(rngDestination.Cells(1, 14), 
 rngDestination.Cells(lastRow, 14))
       If Not datum.Value = "" Then
         datum.Cells(1, 10).Value = Format(datum.Cells(1, 1), "dd/mm/yyyy")
       End If
Next datum
 For Each kette In Range(rngDestination.Cells(1, 1), 
 rngDestination.Cells(lastRow, 1))
  kette.Cells(1, 0).Value = kette.Cells(1, 23).text& & kette.Cells(1, 5).text
Next kette

Upvotes: 0

Views: 66

Answers (2)

user4039065
user4039065

Reputation:

Try bringing it together at once in an array and then dumping the values back.

dim arr as variant, tmp as variant, i as long

with rngDestination
    arr = .Range(rngDestination.Cells(1, 14),  rngDestination.Cells(lastRow, 14)).value2
    tmp = .Range(rngDestination.Cells(1, 5),  rngDestination.Cells(lastRow, 5)).value2
    for i =lbound(arr, 1) to ubound(arr, 1)
        if cbool(len(arr(i, 1))) then
            arr(i, 1) = int(arr(i, 1))
        else
            arr(i, 1) = vbnullstring
        end if
    next i
    .Cells(1, 23).resize(ubound(arr, 1), ubound(arr, 1)) = arr
    .Cells(1, 23).resize(ubound(arr, 1), ubound(arr, 1)).numberformat = "dd/mm/yyyy"
    for i =lbound(arr, 1) to ubound(arr, 1)
        arr(i, 1) = format(arr(i, 1), "dd/mm/yyyy") & tmp(i, 1)
    next i
    .Cells(1, 0).resize(ubound(arr, 1), ubound(arr, 1)) = arr
end with

Upvotes: 1

QHarr
QHarr

Reputation: 84465

Work with arrays and typed functions? Not tested.

 Dim rng As Range, arr(), i As Long
 Set rng = Range(rngDestination.Cells(1, 14), rngDestination.Cells(lastRow, 14))

 arr = rng.Value
 For i = LBound(arr, 1) To UBound(arr, 1)
   If Not IsEmpty(arr(i, 1)) Then
       arr(i, 1) = Format$(arr(i, 1), "dd/mm/yyyy")
   End If
 Next

 rng = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr, 0, 1))

Upvotes: 1

Related Questions