View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
docksi docksi is offline
external usenet poster
 
Posts: 8
Default Data define and search function request?

'wrote this with my 3 month old on my shoulder. needs reference to
adodb and error trapping etc...

Sub Crabtree()


Dim cd() As Variant
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sql, crt, crt1 As String
Dim i, t, k, j As Integer

Sheets("codes").Activate
Sheets("codes").Range("a1").Select
Range(Selection, Selection.End(xlDown)).Select
t = Selection.Rows.Count

startdate = InputBox("Enter Start Date: ")
enddate = InputBox("Enter End Date: ")

ReDim cd(1 To t)

Sheets("codes").Range("a1").Select
For i = 1 To t
cd(i) = Selection.Value
Selection.Offset(1, 0).Select

Next i

crt = "('" & cd(1)

For j = 2 To t - 1

crt1 = crt1 & "','" & cd(j)

Next j

crt = crt & crt1 & "')"


Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & ActiveWorkbook.Path & "\" &
ActiveWorkbook.Name & ";Extended Properties=Excel 8.0; "
.Open
End With


sql = "select date as dt,code,sum(quantity) as Qt , sum(value) as Vl "
sql = sql & " from [data$]"
sql = sql & " where code in " & crt
sql = sql & " and date=#" & startdate & "# and date<=#" & enddate
sql = sql & "# group by date,code"

Set rs = New ADODB.Recordset
rs.Open sql, cn, adOpenStatic, adLockReadOnly, -1

Sheets("output").Activate
Sheets("output").Range("a1").Select
Selection.CurrentRegion.Select
Selection.ClearContents

Sheets("output").Cells(1, 1) = "Date"
Sheets("output").Cells(1, 2) = "Code"
Sheets("output").Cells(1, 3) = "Quantity"
Sheets("output").Cells(1, 4) = "Value"

rs.MoveFirst
For k = 0 To rs.RecordCount - 1

Sheets("output").Cells(k + 2, 1) = rs.Fields.Item(0).Value
Sheets("output").Cells(k + 2, 2) = rs.Fields.Item(1).Value
Sheets("output").Cells(k + 2, 3) = rs.Fields.Item(2).Value
Sheets("output").Cells(k + 2, 4) = rs.Fields.Item(3).Value
rs.MoveNext
Next k


End Sub