Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

importing totals into excell

Status
Not open for further replies.

metalman

Programmer
Sep 17, 2001
35
US
i am using an access2000 database with excell office 2000 profesional. i am trying to read the database by item numbers to put the amount in a spreadsheet. i have it populating the spreeadsheet but it does it one amount at a time from left to right. what i need is the total of each item number to populate from top to bottom. below is the code i am using. i would appreciate any help or ideas on this.

Option Explicit
'rick
Public RowsCount As Integer
Public ColsCount As Integer

Public gColNameArr() As Variant
Public gRowNameArr() As Variant
Public gItemNumsArr() As Integer
Public gWhereStrArr() As String

Public fields As Collection

Public Sub Run()
Initialize
Import
End Sub
Public Sub Initialize()
Dim sht As Worksheet
Dim i As Integer
Dim j As Integer
Dim str As String
Dim where_str As String

ColsCount = 40
RowsCount = 80

ReDim gColNameArr(1 To ColsCount)
ReDim gRowNameArr(1 To RowsCount)
ReDim gItemNumsArr(1 To RowsCount, 1 To 7)
ReDim gWhereStrArr(1 To RowsCount)

'set columns array
Set sht = Worksheets("detail")
With sht
For i = 1 To 39
gColNameArr(i) = .Cells(5, i + 1)
Next i

For i = 1 To 80
gRowNameArr(i) = .Cells(i + 8, 1)
Next i
End With
Set sht = Nothing

Set sht = Worksheets("data")
With sht
For i = 1 To RowsCount
where_str = "WHERE ("
For j = 1 To 7
str = .Cells(i, j + 1)
If str = "" Then
gItemNumsArr(i, j) = 0
Else
gItemNumsArr(i, j) = CInt(str)
where_str = where_str & "EntryTable.[Item Number] = " & str & " OR "
End If
Next j
gWhereStrArr(i) = Left$(where_str, Len(where_str) - 4) & ") "
Next i
End With
End Sub


Public Sub Import()
Dim sht As Worksheet
Dim sht1 As Worksheet
Dim conn_str As String
Dim sql_str As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer
Dim j As Integer
Dim Amount As Double
Dim f As String

conn_str = "Provider=Microsoft.Jet.OLEDB.4.0.0; Data Source=C:\Documents and Settings\rhinson\My Documents\daily reports.mdb"
Set cn = New Connection

cn.Open conn_str
Set sht = Worksheets("Detail")
Set sht1 = Worksheets("Data")
For i = 1 To RowsCount
DoEvents
For j = 1 To ColsCount
DoEvents
Amount = 0
Set rs = New Recordset
If gWhereStrArr(i) <> &quot;WHE) &quot; Then
sql_str = &quot;SELECT DISTINCT EntryTable.Amount as m &quot; _
& &quot;FROM (EntryTable INNER JOIN HeaderTable ON EntryTable.ID = HeaderTable.ID) &quot; _
& &quot;INNER JOIN ItemTable ON EntryTable.[Item number] = ItemTable.[Item Number] &quot; _
& gWhereStrArr(i) _
& &quot;AND (((ItemTable.Location)='&quot; & gColNameArr(j) & &quot;'))&quot;
Else
sql_str = &quot;SELECT DISTINCT EntryTable.Amount as m &quot; _
& &quot;FROM (EntryTable INNER JOIN HeaderTable ON EntryTable.ID = HeaderTable.ID) &quot; _
& &quot;INNER JOIN ItemTable ON EntryTable.[Item number] = ItemTable.[Item Number] &quot; _
& &quot;WHERE ItemTable.Location = '&quot; & gColNameArr(j) & &quot;'&quot;
End If
rs.Open sql_str, cn, adOpenStatic, adLockReadOnly
Debug.Print sql_str
While Not rs.EOF
Amount = Amount + rs.fields(&quot;m&quot;)
rs.MoveNext
Wend
sht.Cells(i + 7, j + 1) = Amount
rs.Close
Set rs = Nothing
Next j
Next i

cn.Close
Set cn = Nothing
End Sub





 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top