PDA

View Full Version : Solved: Help needed



Rayman
11-10-2011, 03:22 PM
here i am again looking for help from the member of this helpful forum:

I attached a semplified example of my working sheets.

In column A there is a date, in column B a type of work and in column C the quantity of that work made in a days.

What i need to do with Vba is find the average work by type in a range of date.

My english is very poor , its best explanatory the example workbook with the macro i made that is partially working but with wrong result.

Any help will be very appreciated.

Thanks in advance

GTO
11-10-2011, 03:45 PM
Hi Rayman,

Not sure if I'll be online much longer, may have to run out. Just if you're still about, could you edit the attachment and put it in .xls format?

Rayman
11-10-2011, 03:53 PM
Hi Rayman,

Not sure if I'll be online much longer, may have to run out. Just if you're still about, could you edit the attachment and put it in .xls format?

Thanks for reply GTO , here is the .xls file

mdmackillop
11-10-2011, 04:52 PM
Option Explicit

Sub Test()
Dim rType As Range, rDateCol As Range, rDates As Range, cel As Range
Dim colType As New Collection
Dim colDate As New Collection
Dim LR As Long, i As Long, x As Long
Dim ct, cd

LR = Cells(Rows.Count, 2).End(xlUp).Row
Set rType = Range(Cells(2, 2), Cells(LR, 2))

Set rDateCol = rType.Offset(, -1)
Set rDates = rDateCol.Offset(, 3)

'Create column of dates
rDateCol.Copy rDates
Cells(1, 4) = "Dates"
For Each cel In rDates
If cel = "" Then cel = cel.Offset(-1)
Next

'Create collection of types
On Error Resume Next
For Each cel In rType
colType.Add cel.Text, cel.Text
Next

'Create collection of dates
For Each cel In rDates
colDate.Add cel.Value, CStr(cel.Value)
Next
On Error GoTo 0


i = 2

For Each ct In colType
x = 0
For Each cd In colDate
'Count types for each date
x = x - (Application.CountIfs(rDates, cd, rType, ct) > 0)
Next
'Write results
Cells(i, 6) = ct
Cells(i, 7) = x
Cells(i, 8) = Application.SumIf(rType, ct, rType.Offset(, 1))
Cells(i, 9) = Cells(i, 8) / Cells(i, 7)
i = i + 1
Next
'Clear added column
Columns("D:D").Clear
End Sub

Rayman
11-10-2011, 05:36 PM
PERFECT Md,
works perfectly, great piece of code:thumb

Many thanks to you and to all smart members of this forum.