Importing from Access to excel

sgaurav

Board Regular
Joined
May 16, 2003
Messages
107
I have a tool that I have been using to import data from Access database and then I would make a graph of that. It used to import just fine but since the year has changed(Jan1st) it stopped importing.
I have pasted the code can you please provide some help.
this commandbutton2_click is actually the "import" button

Private Sub CommandButton2_Click()
'Declare variables
Dim Db As Database
Dim Rs As Recordset
Dim Ws As Object
Dim i As Integer
Dim Path As String

Dim MyDatabase As String
Dim DatabaseTable As String
With Sheets("PRRS Information")
MyDatabase = .Range("AccessName")
DatabaseTable = .Range("AccessTable")
End With

Set Ws = Sheets("QRY_Data_PRRS")

'This set of code will activate Sheet1 and clear any existing data
'After clearing the data it will select cell A1
Ws.Activate
Ws.Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Ws.Range("A1").Select

'Set the Database, and RecordSet This Table exists in the database
Set Db = Workspaces(0).OpenDatabase(MyDatabase, ReadOnly:=True)

'This will set the RecordSet to all records in the Customers table
Set Rs = Db.OpenRecordset(DatabaseTable)

'This loop will collect the field names and place them in the first
'row starting at "A1"
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next i

'The next line simply formats the headers to bold font
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold = True

'The next line will get the data from the recordset and copy it
'into the Worksheet (Sheet1).
Ws.Range("A2").CopyFromRecordset Rs

'This next code set will just select the data region and
'auto-fit the columns
Sheets("QRY_Data_PRRS").Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Sheets("QRY_Data_PRRS").Range("A1").Select

Rs.Close
Db.Close
End Sub

Private Sub PRRSDataButton_Click()

Application.ScreenUpdating = False

Sheets("PRRS Information").Select
YearNum = ActiveSheet.Cells(8, 4)
MonthNum = ActiveSheet.Cells(7, 4)
WeekNum = ActiveSheet.Cells(6, 4)

Count = 2
Sheets("QRY_Data_PRRS").Select
Do While ActiveSheet.Cells(Count, 1) <> ""
If ActiveSheet.Cells(Count, 12) = YearNum Then
'For Year
YNumCases = YNumCases + 1
YNumTests = YNumTests + ActiveSheet.Cells(Count, 5)
YNumPositive = YNumPositve + ActiveSheet.Cells(Count, 6)
YNumSuspect = YNumSyspect + ActiveSheet.Cells(Count, 7)
YNumInconsistent = YNumInconsistent + ActiveSheet.Cells(Count, 8)
If ActiveSheet.Cells(Count, 11) = MonthNum Then
'For Month
MNumCases = MNumCases + 1
MNumTests = MNumTests + ActiveSheet.Cells(Count, 5)
MNumPositive = MNumPositve + ActiveSheet.Cells(Count, 6)
MNumSuspect = MNumSyspect + ActiveSheet.Cells(Count, 7)
MNumInconsistent = MNumInconsistent + ActiveSheet.Cells(Count, 8)
End If
If ActiveSheet.Cells(Count, 10) = WeekNum Then
'For Week
WNumCases = WNumCases + 1
WNumTests = WNumTests + ActiveSheet.Cells(Count, 5)
WNumPositive = WNumPositve + ActiveSheet.Cells(Count, 6)
WNumSuspect = WNumSyspect + ActiveSheet.Cells(Count, 7)
WNumInconsistent = WNumInconsistent + ActiveSheet.Cells(Count, 8)
End If
End If
Count = Count + 1
Loop

Sheets("PRRS Information").Select
'Paste Results
'Week
ActiveSheet.Cells(12, 6).Value = WNumCases
ActiveSheet.Cells(14, 3).Value = WNumTests
ActiveSheet.Cells(14, 4).Value = WNumPositive
ActiveSheet.Cells(14, 5).Value = WNumSuspect
ActiveSheet.Cells(14, 6).Value = WNumInconsistant
'Month
ActiveSheet.Cells(18, 6).Value = MNumCases
ActiveSheet.Cells(20, 3).Value = MNumTests
ActiveSheet.Cells(20, 4).Value = MNumPositive
ActiveSheet.Cells(20, 5).Value = MNumSuspect
ActiveSheet.Cells(20, 6).Value = MNumInconsistant
'Year
ActiveSheet.Cells(24, 6).Value = YNumCases
ActiveSheet.Cells(26, 3).Value = YNumTests
ActiveSheet.Cells(26, 4).Value = YNumPositive
ActiveSheet.Cells(26, 5).Value = YNumSuspect
ActiveSheet.Cells(26, 6).Value = YNumInconsistant

End Sub




Sub graphInformation()
Application.ScreenUpdating = False

Dim TempArray(52, 5)

Sheets("PRRS Information").Select
For i = 4 To 54
If ActiveSheet.Cells(i - 1, 18) = 1 Then
ActiveSheet.Cells(i, 18).FormulaR1C1 = 53
ActiveSheet.Cells(i, 19).FormulaR1C1 = 2003
Else
ActiveSheet.Cells(i, 18).FormulaR1C1 = Val(ActiveSheet.Cells(i - 1, 18)) - 1
ActiveSheet.Cells(i, 19).FormulaR1C1 = ActiveSheet.Cells(i - 1, 19)
End If
Next i
For i = 3 To 54
TempArray(i - 2, 0) = ActiveSheet.Cells(i, 18) & "/" & ActiveSheet.Cells(i, 19)
Next i

Sheets("QRY_Data_PRRS").Select
Count = 2
Do While ActiveSheet.Cells(Count, 1) <> ""
TempDate = ActiveSheet.Cells(Count, 10) & "/" & ActiveSheet.Cells(Count, 12)
For i = 1 To 52
If TempArray(i, 0) = TempDate Then
TempArray(i, 1) = TempArray(i, 1) + ActiveSheet.Cells(Count, 6) + ActiveSheet.Cells(Count, 7) '# Pos + # Suspect + Previous Counts
TempArray(i, 2) = TempArray(i, 2) + ActiveSheet.Cells(Count, 8) 'Incostintent 'Previous Counts + # Inconsistant
TempArray(i, 3) = TempArray(i, 3) + ActiveSheet.Cells(Count, 5) 'PRRS count 'Previous Counts + # PRRS
TempArray(i, 4) = TempArray(i, 4) + ActiveSheet.Cells(Count, 6) 'Positive 'Previous Counts + # Positive
TempArray(i, 5) = TempArray(i, 5) + ActiveSheet.Cells(Count, 7) 'Suspect
i = 53
End If
Next i
Count = Count + 1
Loop

Sheets("PRRS Information").Select
For i = 3 To 54
If TempArray(i - 2, 1) = "" Then
'ActiveSheet.Cells(i, 20).Value = 0
'ActiveSheet.Cells(i, 21).Value = 0
'ActiveSheet.Cells(i, 22).Value = 0
'ActiveSheet.Cells(i, 23).Value = 0
'ActiveSheet.Cells(i, 24).Value = 0
'ActiveSheet.Cells(i, 25).Value = 0
'ActiveSheet.Cells(i, 26).Value = 0
ActiveSheet.Cells(i, 20).Value = 0
ActiveSheet.Cells(i, 21).Value = 0
ActiveSheet.Cells(i, 22).Value = 0
ActiveSheet.Cells(i, 23).Value = 0
ActiveSheet.Cells(i, 16).Value = 0
ActiveSheet.Cells(i, 17).Value = 0

Else
ActiveSheet.Cells(i, 20).Value = TempArray(i - 2, 1)
ActiveSheet.Cells(i, 21).Value = TempArray(i - 2, 2)
ActiveSheet.Cells(i, 22).Value = TempArray(i - 2, 3)
ActiveSheet.Cells(i, 23).Value = (TempArray(i - 2, 3) - TempArray(i - 2, 4)) / TempArray(i - 2, 3)
ActiveSheet.Cells(i, 16).Value = TempArray(i - 2, 4)
ActiveSheet.Cells(i, 17).Value = TempArray(i - 2, 5)
End If
Next i
End Sub
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Forum statistics

Threads
1,147,676
Messages
5,742,555
Members
423,737
Latest member
tom_xls

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