Trim whitespaces when using CopyFromRecordSet

Question

I have a spreadsheet , that I am trying to optimize.

I have to take each value in a column, and get 3 "corresponding" values from a SQL server, the way it was done before, was that each column value resulted in 1 SQL lookup, so just to update the single sheet, more than 75.000 sql request were called. (7.5 hours)

I then rewrote it, to just do a single SQL call, and get the entire table into a "local" recordset, and compare each column value against the recordset and write the corresponding columns (50 minutes)

To improve even further I created a local recordset

Set rs = New ADODB.Recordset
With rs.Fields
  .Append "registreringsnr", adChar, 50
  .Append "security_type", adChar, 50
  .Append "security_group", adChar, 128
End With

Compared each column value against the recordset from SQL, and the adding the value to my "rs" Recordset, and when I am done, I do a:

CopyFromRecordSet rs

The issue is, that fields in rs is fixed in length, so if "registreringsnr" is 2 chars, then it will append 48 whitespaces.

Is there a way to remove the whitespaces, without having to loop through 3 columns with 25.000 cells in each and removing WhiteSpaces ?

Answer 1

Filling a range of 3 x 25000 cells with the below code ( just for testing purposes )

Sub Fill()
Application.ScreenUpdating = False
    Dim i As Long, j As Long
    For i = 1 To 25000
        For j = 1 To 3
            Cells(i, j) = Chr(32) & Chr(32) & Chr(32) & Int((50 - 0 + 1) * Rnd + 0) & _
                            Chr(32) & Chr(32) & Chr(32)
        Next j
    Next i
Application.ScreenUpdating = True
End Sub

and running

Sub Trimming()
Application.ScreenUpdating = False
    Dim stNow As Date
    stNow = Now
    Dim i As Long, j As Long
    For i = 1 To 25000
        For j = 1 To 3
            Cells(i, j) = Trim(Cells(i, j))
        Next j
    Next i
    Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub

Takes only 2 seconds to process 75000 cells ( 100% cells need trimming ).

So I am not sure why you are still looking for an alternative method to trim it directly in the recordset.

You could stick it all in an array but this would probably be an overkill if the above only takes approx. 2 seconds.

array takes less than a second on my machine

Sub TrimminArr()
Application.ScreenUpdating = False
    Dim stNow As Date
    stNow = Now
    Dim arr As Variant
    arr = Range("A1:C25000")
    Dim i As Long, j as long
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            arr(i, j) = Trim(arr(i, j))
        Next j
    Next i
    Range("A1:C25000").ClearContents
    Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub