Tranferring data from an excel array to ms access table

carlleese24

Board Regular
Joined
Mar 15, 2005
Messages
108
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
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,119
Messages
5,835,500
Members
430,362
Latest member
ConnerJ

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top