>If you are dumping data into Excel, then my guess is that it is Excel doing the data coercion - not ADO...

>If you are dumping data into Excel, then my guess is that it is Excel doing the data coercion - not ADO...

Well, actually, both will do their thing.

If you look at the screen dump, you can see that the YYYY.MM.DD string is shown as MM/DD/YYYY. This happens right after the ADO open recordset call and before any further processing.

Anyway, here is the code.

Sub ChooseData()

    Dim rs As ADODB.Recordset
    Dim sSQL, WhrIt, varList, thisVar, SortIt, SortVar, SortOrdr As String
    Dim rd, kolonne(maxInReadBuffer, 1) As Variant
    Dim a, b, i, j, X, Y, FrBase, ToBase, Max As Integer
    Dim LoopCntl, MultiRead As Boolean
    
    Application.ScreenUpdating = False
    
    Set rs = New ADODB.Recordset
    
    For i = 1 To WhrRow
        Select Case i
            Case 1
                WhrIt = " WHERE " & _
                        frmDB.LP1.Caption & _
                        frmDB.ShowBox1.List(0) & _
                        frmDB.RP1.Caption
            Case 2
                WhrIt = WhrIt & " " & _
                        frmDB.AndOr1.Caption & " " & _
                        frmDB.LP2.Caption & " " & _
                        frmDB.ShowBox2.List(0) & _
                        frmDB.RP2.Caption
            Case 3
                WhrIt = WhrIt & " " & _
                        frmDB.AndOr2.Caption & " " & _
                        frmDB.LP3.Caption & " " & _
                        frmDB.ShowBox3.List(0) & _
                        frmDB.RP3.Caption
            Case 4
                WhrIt = WhrIt & " " & _
                        frmDB.AndOr3.Caption & " " & _
                        frmDB.LP4.Caption & " " & _
                        frmDB.ShowBox4.List(0) & _
                        frmDB.RP4.Caption
            Case 5
                WhrIt = WhrIt & " " & _
                        frmDB.AndOr4.Caption & " " & _
                        frmDB.LP5.Caption & " " & _
                        frmDB.ShowBox5.List(0) & _
                        frmDB.RP5.Caption
            Case 6
                WhrIt = WhrIt & " " & _
                        frmDB.AndOr5.Caption & " " & _
                        frmDB.LP6.Caption & " " & _
                        frmDB.ShowBox6.List(0) & _
                        frmDB.RP6.Caption
        End Select
    Next i
    
    ' Variable list
    varList = ""
    For i = 1 To numCols
        Select Case varTypen(i)
            Case "B"
                thisVar = _
                    Chr(39) & " " & Chr(39) & " AS DUMMY" & i
            Case Else
                thisVar = varName(i)
        End Select
        varList = varList & thisVar & ","
    Next i
    varList = Left(varList, Len(varList) - 1)
    
    ' Sorting sentence
    If frmDB.cboSort.Value Then
        SortIt = " ORDER BY "
        For i = 1 To AntalVar
            SortVar = frmDB.SortVars.List(i - 1, 0)
            ' Find the variable name and exchange
            For j = 1 To numCols
                If SortVar = varLabel(j) Then
                    SortVar = varName(j)
                    Exit For
                End If
            Next j
            SortOrdr = " " & frmDB.SortVars.List(i - 1, 1)
            If i < AntalVar Then
                SortIt = SortIt & SortVar & SortOrdr & ","
            Else
                SortIt = SortIt & SortVar & SortOrdr
            End If
        Next i
    Else
        SortIt = ""
    End If
        
    sSQL = "SELECT " & varList & " FROM " & connectTable & WhrIt & SortIt

    On Error GoTo dbError
    rs.Open sSQL, connectString, adOpenForwardOnly, adLockOptimistic			'Reformat occurs here!
    
    ' Test if any records returned
    If rs.EOF Then
        MsgBox "No records returned with these criteria", vbOKOnly, "No records"
        Exit Sub
    End If
    
    rd = rs.GetRows
    On Error GoTo 0
    
    i = UBound(rd, 1)
    j = UBound(rd, 2)
    
    StatusMsg (j + 1 & " rows returned from database.")
    
    If j > maxDbRows Then
        ' Reached max number of rows wanted in Excel sheet - issue warning !
        MsgBox "Reached max number of rows wanted, so no rows returned !", vbCritical, "Database warning"
        i = -1
        j = -1
    End If
    
    b = 1
    If j > maxInReadBuffer Then
        Max = maxInReadBuffer
        MultiRead = True
    Else
        Max = j + 1
        MultiRead = False
    End If
    
    FrBase = 20
    ToBase = FrBase + maxInReadBuffer - 1
    
    Do
        For X = 0 To i
            For Y = b To Max
                kolonne(Y - b + 1, 1) = rd(X, Y - 1)
            Next Y
            Range(Cells(FrBase, X + 1), Cells(ToBase, X + 1)).Value = kolonne
            Erase kolonne
        Next X
        If MultiRead Then
            ' Fill more to kolonne and cells
            FrBase = FrBase + maxInReadBuffer
            ToBase = FrBase + maxInReadBuffer - 1
            b = b + maxInReadBuffer
            Max = Max + maxInReadBuffer
            If Max > j Then
                Max = j + 1
                MultiRead = False
            End If
            LoopCntl = False
        Else
            LoopCntl = True
        End If
    Loop Until LoopCntl

    StatusMsg ("Formatting initiated.")
    
    rs.Close
    Set rs = Nothing
    Exit Sub
dbError:
    MsgBox "DB error"
    Exit Sub
End Sub

Regards and TIA