Tranferring data from an excel array to ms access table

carlleese24

Board Regular
Joined
Mar 15, 2005
Messages
106
Hi

I am trying to transfer data that's in this format table format to ms access.

descriptionValuesDates_Year_Wk_no


Heres the code below I am using which puts the data into an array like the table above but I keep getting Type mismatch error message when it tries to transfer the data to Ms access. The code highlighted in red is used to transfer the data to ms access. If someone could please help me resolve this issue many thanks in advance..

Code:
Sub sbAExampleOnTwoDimnsionalArray11()

    Dim ArrayFinalData()
    Dim lrows As Long
    Dim lcols As Long
    
With Sheets("FinalData")

   Description_Col = 1
   Titles = 3 + 1 'e.g years, wk no, dates
   
LR = Sheets("FinalData").Range("a" & Sheets("FinalData").Rows.Count).End(xlUp).Row - Titles + 1
LR2 = LR + 1
   
   lcols = .Cells(5, .Columns.Count).End(xlToLeft).Column - Description_Col
    lcolsa = .Cells(5, .Columns.Count).End(xlToLeft).Column * LR + 1
    lrows = Titles + Description_Col
End With

 
    ReDim Preserve ArrayFinalData(0 To lcolsa, 0 To lrows)
     

For h = 1 To lcols

If k = 0 Then
k = k + LR2
m = m + 1
End If

If m = LR2 Then
m = m + 1
End If

If i = LR2 Then
i = i + 1
End If


For i = m To k

If L = 0 Then
L = L + Titles
Else
L = L + 1
End If

   
If i = 1 Then
 i = i - 1

     ArrayFinalData(i, 0) = "description"
    ArrayFinalData(i, 1) = "Values"
    ArrayFinalData(i, 2) = "Dates_"
    ArrayFinalData(i, 3) = "Year_"
    ArrayFinalData(i, 4) = "Wk_no"
     i = i + 2
        
End If
    
    For j = 1 To 2
    
     h = h + 1
    i = i - 1
    ArrayFinalData(i, 0) = Sheets("FinalData").Cells(L, 1)
    ArrayFinalData(i, 1) = Sheets("FinalData").Cells(L, h)
    ArrayFinalData(i, 2) = Sheets("FinalData").Cells(3, h)
    ArrayFinalData(i, 3) = Sheets("FinalData").Cells(1, h)
    ArrayFinalData(i, 4) = Sheets("FinalData").Cells(2, h)
    
 i = i + 1
   h = h - 1
   
      
   
    Next j
 

   Next i

L = L - LR


If i < lcolsa Then
k = k + LR
m = m + LR
End If

Next h


Dim Destination As Range
Set Destination = Range("z16")
Destination.Resize(UBound(ArrayFinalData, 1), UBound(ArrayFinalData, 2)).Value = ArrayFinalData


[COLOR="#FF0000"]   

    Dim cnn As ADODB.Connection
    Dim MyConn
    Dim rst As ADODB.Recordset
  
 
    TARGET_DB = "C:\info.accdb"

    Set cnn = New ADODB.Connection
    MyConn = TARGET_DB
    
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Open MyConn
    End With


    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:="Table1", ActiveConnection:=cnn, _
             CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
             Options:=adCmdTable

 
For j = 0 To UBound(ArrayFinalData, 1) 'loop through records
 rst.AddNew
 For f = 0 To UBound(ArrayFinalData, 2) 'loop through fields
 rsR.Fields(f).Value = ArrayFinalData(j, f)

 
 Next f
 rst.Update
 Next j

 rst.Close



    
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing

[/COLOR]

End Sub


kind regards
Carl
 

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Watch MrExcel Video

Forum statistics

Threads
1,114,520
Messages
5,548,532
Members
410,845
Latest member
OldSwimmer1650
Top