I'm Lost... Bin? Delineate different processes with time samples

[William Elerding]

Good morning! This is similar to a post I made in the 'Excel Worksheet
Function' section. It seems this query could be put in a few different
sections, and your thoughts would be Very helpful...

I am having a problem trying to analyze the following data.

I will routinely sample the elapsed time of many different processes. I am
provided with a spreadsheet with the process name in 'column A', and the
duration in 'column B' (between 2 and 5k occurances). I would like to
automate the analysis (for others to also use) and set-up a table delineating
each occurance-time by named process. From this I'd like to use a
Bin/Histrogram to summarize this data (for graphs and to report certain
percentiles).

Unfortunately, I can't figure how to seperate the occurance by process so
that I can use the Analytic tools for Histogram. Does anyone have any
suggestions? THANKS! -Bill

The data looks like this:

Duration/
Hour Process
0.2 C
0.1 A
1.3 V
5 G
6.2 R
5.3 S
0.3 G
0.4 A
0.9 A
0.4 C
0.2 B
0.6 F
0.2 B
0.3 B
0.1 B

What I'd like it to look like is:

Process: A B C F V G R S
Times: 0.1 0.2 0.2 0.6 1.3 5 6.2 5.3
0.4 0.2 0.4 0.3
0.9 0.3
0.1
Any suggestions would be very helpful. Thanks!

 

[Greg Wilson]

Assumed is that the ws name is "Process Data". Change to suit. Also assumed
is that the process names are in column B starting in B2 and that the
duration data are listed adjacent in column A.

Written in a hurry (just now) with minimal testing. Ensure you have a backup
copy of your data first:

Sub TestXYZ()
Dim ws As Worksheet
Dim coll As Collection
Dim r As Range, c As Range
Dim i As Integer, ii As Integer
Dim iii As Integer

Set ws = Sheets("Process Data")
Set coll = New Collection
Set r = ws.Range(ws.Cells(2, 2), _
ws.Cells(2, 2).End(xlDown))

On Error Resume Next
For Each c In r.Cells
coll.Add c.Value, c.Value
Next
On Error GoTo 0
Application.ScreenUpdating = False
iii = 1
For i = 1 To coll.Count
ws.Cells(1, i + 4).Value = coll(i)
ii = 1
For Each c In r.Cells
If c.Value = coll(i) Then
ii = ii + 1
iii = IIf(ii > iii, ii, iii)
ws.Cells(ii, i + 4) = c(1, 0).Value
End If
Next
Next
Set r = ws.Range(ws.Cells(1, 4), ws.Cells(2, 4))
r(1).Value = "Process:"
r(2).Value = "Duration:"
r.Font.Bold = True
Set r = ws.Range(ws.Cells(1, 5), ws.Cells(iii, i + 3))
r.HorizontalAlignment = xlHAlignCenter
r.VerticalAlignment = xlVAlignCenter
r.Columns.AutoFit
With r.Rows(1)
.Font.Color = vbRed
.Font.Bold = True
End With
Application.ScreenUpdating = True
End Sub

Regards,
Greg

 

[Greg Wilson]

I made some minor formatting changes only to this version. Suggest you use it
instead:

Sub TestXYZ()
Dim ws As Worksheet
Dim coll As Collection
Dim r As Range, c As Range
Dim i As Integer, ii As Integer
Dim iii As Integer

Set ws = Sheets("Process Data")
Set coll = New Collection
Set r = ws.Range(ws.Cells(2, 2), _
ws.Cells(2, 2).End(xlDown))

On Error Resume Next
For Each c In r.Cells
coll.Add c.Value, c.Value
Next
On Error GoTo 0
Application.ScreenUpdating = False
iii = 1
For i = 1 To coll.Count
ws.Cells(1, i + 4).Value = coll(i)
ii = 1
For Each c In r.Cells
If c.Value = coll(i) Then
ii = ii + 1
iii = IIf(ii > iii, ii, iii)
ws.Cells(ii, i + 4) = c(1, 0).Value
End If
Next
Next
Set r = ws.Range(ws.Cells(1, 4), ws.Cells(2, 4))
r(1).Value = "Process:"
r(2).Value = "Duration:"
r.Font.Color = vbRed
r.Font.Bold = True
Set r = ws.Range(ws.Cells(1, 5), ws.Cells(iii, i + 3))
r.HorizontalAlignment = xlHAlignCenter
r.VerticalAlignment = xlVAlignCenter
r.Columns.AutoFit
With r.Rows(1)
..Font.Color = vbRed
..Font.Bold = True
End With
Application.ScreenUpdating = True
End Sub

 

[William Elerding]

Worked like a charm! It is going to take me a while to figure it out HOW it
works, but that is left to my 'personal time'. BTW, good luck on your
Laboratory program, you certainly got our curiosity up...

 

[William Elerding]

A grand afternoon, Greg. I have a follow-up question I'd like to pose to
you...

How would I modify the Macro to report the results on a different worksheet,
and also to pull the data (Time and Process) from two columns other than
Column A & B on the sheet "Process Data"? The two columns are actually in
Columns X and Y.

 

[Greg Wilson]

William, I have changed the macro to obtain the duration times and process
names from columns X and Y respectively of sheet "Process Data". The results
will be copied to sheet "Chart Data" starting in A1. I have included a few
comments to assist you with understanding.

Sub TestXYZ()
Dim ws As Worksheet, ws2 As Worksheet
Dim coll As Collection
Dim r As Range, r2 As Range
Dim c As Range
Dim i As Integer, ii As Integer
Dim iii As Integer

Set ws = Sheets("Process Data")
Set ws2 = Sheets("Chart Data")
Set coll = New Collection
'Number 25 references column "Y" of ws
Set r = ws.Range(ws.Cells(2, 25), _
ws.Cells(2, 25).End(xlDown))
'See John Walkenbauch's site for following
'technique to create collection of unique items only
'http://www.j-walk.com/ss/excel/tips/tip47.htm
On Error Resume Next
For Each c In r.Cells
coll.Add c.Value, c.Value
Next
On Error GoTo 0

Application.ScreenUpdating = False
iii = 1
For i = 1 To coll.Count
ws2.Cells(1, i + 1).Value = coll(i)
ii = 1
For Each c In r.Cells
If c.Value = coll(i) Then
ii = ii + 1
'iii records maximum length of list
iii = IIf(ii > iii, ii, iii)
ws2.Cells(ii, i + 1) = c(1, 0).Value
End If
Next
Next
'Number 1 references column "A" of ws2
Set r = ws2.Range(ws2.Cells(1, 1), ws2.Cells(2, 1))
r(1).Value = "Process: "
r(2).Value = "Duration: "
'Number 2 references column "B" of ws2
'i = count of unique process names + 1
Set r2 = ws2.Range(ws2.Cells(1, 2), ws2.Cells(iii, i))
r2.HorizontalAlignment = xlHAlignCenter
r2.VerticalAlignment = xlVAlignCenter
ws2.Range(r, r2).Columns.AutoFit
With Union(r, r2.Rows(1))
.Font.Color = vbRed
.Font.Bold = True
End With
Application.ScreenUpdating = True
End Sub

P.S.
Thanks for your concern about my lab management program. If you read enough
of the thread you will know that I am (was) thoroughly p***ed off with my
employer. I did follow through and quit. Today, coincidentally, was the first
day with the new company. The lab manager (former company) gave notice one
week after I did. The place is now pretty much gutted for real experience.
And there is serious question as to their viability. I can't imagine why
someone would think that <g>.

Regards,
Greg