Data define and search function request?

[joecrabtree]

All,

I have posted this already, but still have had no joy... and takers??

Thanks....

I have a workbook with three (3) worksheets in it. The first one is
called 'codes' the second one is called 'data', and the third one is
called 'output'.

In 'codes' there is a list of codes that appear in the data set for
example:

CODES:
ABC
BGD
JDJ
KDK
DID

In the sheet 'data' the data is in the following format:

DATE CODE QUANTITY VALUE
01/01/09 ABC 10 1000
01/01/09 ABC 1 100
01/01/09 KDK 4 44
02/01/09 JDJ 2 13
02/01/09 JDJ 33 22

What I would like to be able to do is as follows:

1) The user is asked to input a date range for example
01/01/09-01/01/09
2) The program then searchs the data for everything in that date range
in the 'data' sheet that corresponds to the codes defined in the
'codes' sheet and returns the summed values. For example when the user
enters in 01/01/09-01/01/09 the value returned would be:

CODE QUANTITY VALUE
ABC 11 1100

3) This data would be displayed in the 'output' worksheet.
4) If the User entered the date range 01/01/09-02/01/09 then the
following values would be returned:

DATE CODE QUANTITY VALUE
01/01/09 ABC 11 1100
01/01/09 KDK 4 44
02/01/09 JDJ 35 35

If anyone could help it would be much appreciated,

Regards

Joseph Crabtree

 

[JP]

Did you try Pivot Tables? You can aggregate your data by days/weeks/
months and look at sums, counts, averages, etc.

HTH
--JP

 

[Joel]

Sub GetOutput()

Do
StartDate = InputBox("Enter Start Date : ")
Loop While Not IsDate(StartDate)
StartDate = DateValue(StartDate)

Do
EndDate = InputBox("Enter End Date : ")
Loop While Not IsDate(EndDate)
EndDate = DateValue(EndDate)

If StartDate > EndDate Then
MsgBox ("Exiting Macro - End Date is before Start Date")
Exit Sub
End If

With Sheets("Output")
If .Range("A1") = "" Then
.Range("A1") = Date
.Range("B1") = Code
.Range("C1") = Quantity
.Range("D1") = Value
OutputRow = 2
Else
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
OutputRow = LastRow + 1
End If
End With


With Sheets("Codes")
CodeRow = 1
Do While .Range("A" & CodeRow) <> ""
Code = .Range("A" & CodeRow)

With Sheets("Data")
Set c = .Columns("B").Find(what:=Code, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddr = c.Address
Do
Date = c.Offset(0, -1)
If Date >= StartDate And Date <= EndDate Then
.Range("A" & c.Row & "" & c.Row).Copy _
Destination:=Sheets("Output").Range("A" & OutputRow)
OutputRow = OutputRow + 1
End If
Set c = .Columns("B").FindNext(after:=c)
Loop While Not c Is Nothing And c.Address <> FirstAddr
End If

End With
CodeRow = CodeRow + 1
Loop
End With
End Sub

 

[joecrabtree]

Yes - but I was trying to make it more automated, i,.e. using VBA...

 

[docksi]

'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

 

[joecrabtree]

Sorry I don't understand adodb - is there an easy way to get this
work?

Thanks

Joe Crabtree

 

[JP]

Um, automate the pivot table creation?

http://www.google.com/search?hl=en&q=create+pivot+table+using+vba&btnG=Google+Search

 

[joecrabtree]

Sub GetOutput()

Do
   StartDate = InputBox("Enter Start Date : ")
Loop While Not IsDate(StartDate)
StartDate = DateValue(StartDate)

Do
   EndDate = InputBox("Enter End Date : ")
Loop While Not IsDate(EndDate)
EndDate = DateValue(EndDate)

If StartDate > EndDate Then
   MsgBox ("Exiting Macro - End Date is before Start Date")
   Exit Sub
End If

With Sheets("Output")
   If .Range("A1") = "" Then
      .Range("A1") = Date
      .Range("B1") = Code
      .Range("C1") = Quantity
      .Range("D1") = Value
      OutputRow = 2
   Else
      LastRow = .Range("A" & Rows.Count).End(xlUp).Row
      OutputRow = LastRow + 1
   End If
End With

With Sheets("Codes")
   CodeRow = 1
   Do While .Range("A" & CodeRow) <> ""
      Code = .Range("A" & CodeRow)

      With Sheets("Data")
         Set c = .Columns("B").Find(what:=Code, _
            LookIn:=xlValues, lookat:=xlWhole)
         If Not c Is Nothing Then
            FirstAddr = c.Address
            Do
               Date = c.Offset(0, -1)
               If Date >= StartDate And Date <= EndDate Then
                  .Range("A" & c.Row & "" & c.Row).Copy _
                    Destination:=Sheets("Output").Range("A" & OutputRow)
                  OutputRow = OutputRow + 1
               End If
               Set c = .Columns("B").FindNext(after:=c)
            Loop While Not c Is Nothing And c.Address <> FirstAddr
         End If

      End With
      CodeRow = CodeRow + 1
   Loop
End With
End Sub

This works great thanks. However I was looking to sum the ouput sheet.
For example:

DATE CODE QUANTITY VALUE
01/01/09 ABC 11 1100
01/01/09 KDK 4 44
02/01/09 JDJ 35 35

would be the output of:

DATE CODE QUANTITY VALUE
01/01/09 ABC 10 1000
01/01/09 ABC 1 100
01/01/09 KDK 4 44
02/01/09 JDJ 2 13
02/01/09 JDJ 33 22

with a date range of.
01/01/09-02/01/09

Any ideas on how i can make this work? At the moment it just 'extracts
and copies' the data.

Thanks allot for your help in advance.

Regards

Joseph Crabtree