List unique entries and total cells based on the results

[Thebatfink]

Hi,

Basically from Sheet OEE V20:V500 I have a list of problems being selected from a drop down list validation (which users can add to the list for new problems). Along side these "problems" in Sheet OEE U20:U500 I have a number which represents the number of minutes the problem caused them. Some cells in both these columns will however be empty if there was no problem occour. But wherever there is a problem selected, there will be a number alongside it, there will never be one without the other.

What I want to do is look down Sheet OEE V20:V500 and get two lots of information -

The unique problem names (no duplicates of the same problem) in Sheet Reports A1:A100 for example (I may change the range of this).
The number of occurances of each of the problems it lists in Sheets Reports B1:B100.
Count up the total number of minutes of each problem. So for every occurance of "Paper problem" there will be a unique number in Column U in the same row as the problem and place this in Sheet Reports C1:C100.

I would ideally like to have this as VB code as I am going to tie it into a command button which formats and prints my report page.

I have found various bits of code dotted about the forums for counting unique cell entries but they always seem to produce a list with lots of blank rows (I would like a list one after another without blank rows all over the place) and I'm really struggling to figure out how to make it count up the numbers in the adjacent cell of each entry it sees.

Just in case the list of problems for the cell validation in Sheet OEE V20:V500 is found in Sheet OEE AQ16 downwards.

If anyone could take alook at this and suggest anything it would be greatly appreciated.
Thanks!
Batfink

 

[Richard Schollar]

Hi

Sounds like an ideal use for a pivot table to me - you can add the minutes field twice, one to get a count, the other time to do a sum. You can generate the code for this easily using the macro recorder and then modify to suit you (you can remove the pivot table eg by copying and pasting values) if you so wish after it has run.

 

[Thebatfink]

Will the pivot table automatically update as new data is entered into the spreadsheet??

I havent done a pivot table before and its very important to the workbook that everything is automated. The sheet is generating various reports and charts and information on a production lines overall equipment efficiency and quality data. The person entering the recorded data into the sheet will have little if not any understanding of what it all actually is so having to manual start cutting and pasting isn't going to work well.

All the do is type in the written data into the spreadsheet and then hit two command buttons. One which prints out all the charts and one that produces a report (which is what I want to add this lot in this thread into). The whole book is hidden and protected except for just what they need to see to enter in the data.

Does that make sense?

 

[Richard Schollar]

Well, the pivot table production would presumably be driven by the Report Production button, so it n't update until the button has been pressed. Would this be acceptable for you?

 

[Thebatfink]

If it gets me to where I'm needed to go and doesnt require user interaction beyond a button press I'll try anything at this point!

I had a go at building a pivot table using the wizard yesterday but have had limited success.

I have a pivot table in a sheet which I will hide from the user but I can only seem to get it to do limited stuff not being used to them. I have a table which is listing the the reasons on the left in a column and in the next column a count of the number of occurances. This is fine, but I would like a sum in the next column also.

My plan of attack was going to be drawing the data from this sheet into cells on my report sheet but I'm now wondering how to add an additional column and once this is done how I will remove the "(blank)" row. I presumed I could use some VB to copy down from a specific cell until it hits the first empty cell to pull it into my report page but it has this "(blank)" value there also.

Forgive me if this sounds very obvious, pivots are something I never have thought to use before.

 

[jindon]

You could use PT as Richards mentioned.
This is without PT.

Sub test()
Dim a, i As Long, b(), n As Long
With Sheets("OEE")
    a = .Range("v2", .Range("v" & Rows.Count).End(xlUp)).Offset(,-1).Resize(,2).Value
End With
ReDim b(1 To UBound(a,1), 1 To 4)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a,1)
        If Not IsEmpty(a(i,2)) Then
            If Not .exists(a(i,2)) Then
                n = n + 1 : b(n,1)  a(i,2) : .add a(i,2), n
            End If
            b(.item(a(i,2)),2) = b(.item(a(i,2)),2) + 1
            If a(i,1) <> "" Then
                b(.item(a(i,2)),3) = b(.item(a(i,2)),3) + 1
                b(.item(a(i,2)),4) = b(.item(a(i,2)),4) + a(i,1)
            End If
        End If
    Next
End With
With Sheets("report").Range("a10")
    .CurrentRegion.ClearContents
    .Resize(,4).Value = [{"problem","Total occurence","occurence with min","Total min"}]
End With
End Sub

 

[jindon]

..... Missed the most important line...

With Sheets("report").Range("a10")
    .CurrentRegion.ClearContents
    .Resize(,4).Value = [{"problem","Total occurence","occurence with min","Total min"}]
    .Offset(1).Resize(n,4).Value = b
End With

 

[Thebatfink]

Thanks for the code.

I've put this in and it gets a syntax error on the following line -

                n = n + 1 : b(n,1)  a(i,2) : .add a(i,2), n

Its a little beyond my skills to fix this and I would appreaciate your help.

Thanks!

EDIT
----

Took a stab at guessing the problem missing = here -

                n = n + 1 : b(n,1) = a(i,2) : .add a(i,2), n

I will go and have a play with it now and make sure it doesn't do anything I didnt expect it too and report back. Thanks for the help!

 

[jindon]

Took a stab at guessing the problem missing = here -

                n = n + 1 : b(n,1) = a(i,2) : .add a(i,2), n

I will go and have a play with it now and make sure it doesn't do anything I didnt expect it too and report back. Thanks for the help!

OOps
You are correct.

 

[Thebatfink]

Well the code is working great. So well in fact that I want to apply it to another range in the sheet..

I have tried splicing two lots of code together but its not having it..

Private Sub obreakdown()
Dim a, i As Long, b(), n As Long
With Sheets("OEE")
    a = .Range("v20", .Range("v" & Rows.Count).End(xlUp)).Offset(, -1).Resize(, 2).Value
End With
ReDim b(1 To UBound(a, 1), 1 To 4)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
       If Not IsEmpty(a(i, 2)) Then
        If Not .exists(a(i, 2)) Then
             n = n + 1: b(n, 1) = a(i, 2): .Add a(i, 2), n
       End If
            b(.Item(a(i, 2)), 2) = b(.Item(a(i, 2)), 2) + 1
            If a(i, 1) <> "" Then
               b(.Item(a(i, 2)), 3) = b(.Item(a(i, 2)), 3) + 1
                b(.Item(a(i, 2)), 4) = b(.Item(a(i, 2)), 4) + a(i, 1)
            End If
        End If
    Next
End With
With Sheets("Reports").Range("o4")
    .CurrentRegion.ClearContents
    .Resize(, 4).Value = [{"problem","Total occurence","occurence with min","Total min"}]
    .Offset(1).Resize(n, 4).Value = b
End With
   Worksheets("Reports").Range("o5:r505").Sort _
        Key1:=Worksheets("Reports").Columns("r"), _
        Header:=xlGuess
Dim a, i As Long, b(), n As Long
With Sheets("OEE")
    a = .Range("p20", .Range("p" & Rows.Count).End(xlUp)).Offset(, -1).Resize(, 2).Value
End With
ReDim b(1 To UBound(a, 1), 1 To 4)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
       If Not IsEmpty(a(i, 2)) Then
        If Not .exists(a(i, 2)) Then
             n = n + 1: b(n, 1) = a(i, 2): .Add a(i, 2), n
       End If
            b(.Item(a(i, 2)), 2) = b(.Item(a(i, 2)), 2) + 1
            If a(i, 1) <> "" Then
               b(.Item(a(i, 2)), 3) = b(.Item(a(i, 2)), 3) + 1
                b(.Item(a(i, 2)), 4) = b(.Item(a(i, 2)), 4) + a(i, 1)
            End If
        End If
    Next
End With
With Sheets("Reports").Range("s4")
    .CurrentRegion.ClearContents
    .Resize(, 4).Value = [{"problem","Total occurence","occurence with min","Total min"}]
    .Offset(1).Resize(n, 4).Value = b
End With
   Worksheets("Reports").Range("s5:v505").Sort _
        Key1:=Worksheets("Reports").Columns("r"), _
        Header:=xlGuess
End Sub

I have no doubts this is a grossly inefficient way of doing this but still, my skills are rather limited to recoding the whole thing.
I have also tried having both seperate occurences as seperate subs, both called from a single sub but that isn't working. I guess its to do with the variables being declared at the start of the sub as it falls down when it gets to the second DIM statement, assuming this is the cause how do you undeclare them? Or am I talking silly?

Thanks