View Single Post
  #6   Report Post  
Stevie_mac
 
Posts: n/a
Default

1st, ensure the Sheet exists with the correct name (customise the GetIDs SUB in the Set-up part)
2nd, I've made it more parameterised so you can 'Set-up' how you need...

As before...
* Open VB (Alt+F11)
* In the Project Explorer, right click the project & add a Class
* Name the new Class MyDataRow
* Add the following code to the class

Public ID As String
Public Stage As String
Public Ver As Long
Public EntryDate As String


* In the Project Explorer, right click the project & add a Module
* Add the following 2 (UPDATED) functions to that module

Private Function BuildDataRow(ID As String, _
Stage As String, _
Ver As Single, _
EntryDate As String) As MyDataRow
Dim mdr As New MyDataRow
mdr.ID = ID
mdr.Stage = Stage
mdr.Ver = Ver
mdr.EntryDate = EntryDate
Set BuildDataRow = mdr
End Function



Public Sub GetIDs()
Dim rResults As Range
Dim rID As Range
Dim rStage As Range
Dim rVer As Range
Dim rDate As Range
Dim wkSheet As Worksheet
Dim OutputSheet As Worksheet
Dim dic, key, sKey As String
Set dic = CreateObject("Scripting.Dictionary")

'******* Set-up ### Customise here ### ********

'Set Results sheet name
Set OutputSheet = Workbooks("Output.xls").Sheets("Results")
'Set source data sheet name
Set wkSheet = ThisWorkbook.Sheets("Sheet1")

'Set start points
Set rID = wkSheet.Range("A2")
Set rStage = wkSheet.Range("B2")
Set rVer = wkSheet.Range("C2")
Set rDate = wkSheet.Range("D2")

'Set rResults to start output at A1
Set rResults = OutputSheet.Range("A1")

'*******Read table in wkSheet********

'loop through items

While rID.Text < ""
'Build 2 part 'ID.Stage' key for dic object
sKey = rID.Text & "|" & rStage.Text
'Test see if ID.Stage key has already been seen
If dic.Exists(sKey) Then
'YES - See if this ID.Stage is highest Ver.
If dic(sKey).Ver < rVer.Value Then
Set dic(sKey) = BuildDataRow(rID.Text, _
rStage.Text, _
rVer.Value, _
rDate.Text)
End If
Else
'NO - Store this DataRow as highest ID.Stage
Set dic(sKey) = BuildDataRow(rID.Text, _
rStage.Text, _
rVer.Value, _
rDate.Text)
End If
Set rID = rID.Offset(1)
Set rStage = rStage.Offset(1)
Set rVer = rVer.Offset(1)
Set rDate = rDate.Offset(1)
Wend

'*******List Results********
'Clear output sheet
OutputSheet.Cells.Clear


'Set up titles
rResults.Value = "ID"
rResults.Offset(0, 1).Value = "Stage"
rResults.Offset(0, 2).Value = "Version"
rResults.Offset(0, 3).Value = "Date"

'Set rResults to start output next row
Set rResults = rResults.Offset(1, 0)



For Each key In dic.Keys
'Put ID in cell
rResults.Value = dic(key).ID

'Put Stage in cell.offset 1 col
rResults.Offset(0, 1).Value = dic(key).Stage

'Put Ver in cell.offset 2 cols
rResults.Offset(0, 2).Value = dic(key).Ver

'Put Date in cell.offset 3 cols
rResults.Offset(0, 3).Value = dic(key).EntryDate

'refernece next cell (1 row down)
Set rResults = rResults.Offset(1, 0)
Next

'Show results
OutputSheet.Activate
End Sub


* Now its done - Run macro GetIDs


Let me know how you get on.

Regards - Steve


"leolin" wrote in message ...
to stevie_mac,

so its always not as easy as it seems, i thought i could use your code as a
starting point, but now im getting errors!

the source data is actually in another separate spreadsheet, and the columns
are not in succession: column A = ID, column I = stage, column J = version #,
column K = date (start). and there is another (end) date column i would also
like to pick up from column L.

i get the error 'subscript out of range', would really appreciate your
continued help on this, thanks!!

"Stevie_mac" wrote:

I knocked up a macro that should give the following results...

ID
Stage
Version
Date

169646
Feasibility
0
02-01-2005

169646
Conceptual
0
13-03-2005

169646
Definition + Design
1
06-03-2005

169646
Build + Implement
2
08-12-2005

123497
Feasibility
0
09-01-2005

123497
Conceptual
1
11-04-2005



Is this what you need? If so then...

Heres what to do...
* Open VB (Alt+F11)
* In the Project Explorer, right click the project & add a Class
* Name the new Class MyDataRow
* Add the following code to the class

Public ID As String
Public Stage As String
Public Ver As Long
Public EntryDate As String


* In the Project Explorer, right click the project & add a Module
* Add the following 2 functions to that module

Public Sub GetIDs()
Dim rResults As Range
Dim rTest As Range
Dim wkSheet As Worksheet
Dim OutputSheet As Worksheet
Dim dic, key, sKey As String
Set dic = CreateObject("Scripting.Dictionary")

'******* Set-up ********

'Set Results sheet name
Set OutputSheet = Sheets("Results")
'Set source data sheet name
Set wkSheet = Sheets("Sheet1")
'Set start point (should be 1st item in ID)
Set rTest = wkSheet.Range("A2")
'Set rResults to start output at A1
Set rResults = OutputSheet.Range("A1")

'*******Read table in wkSheet********

'loop through sheets

While rTest.Text < ""
'Build 2 part 'ID.Stage' key for dic object
sKey = rTest.Text & "|" & rTest.Offset(0, 1).Text
'Test see if ID.Stage key has already been seen
If dic.Exists(sKey) Then
'YES - See if this ID.Stage is highest Ver.
If dic(sKey).Ver < rTest.Offset(0, 2).Value Then
Set dic(sKey) = BuildDataRow(rTest)
End If
Else
'NO - Store this DataRow as highest ID.Stage
Set dic(sKey) = BuildDataRow(rTest)
End If
Set rTest = rTest.Offset(1)
Wend

'*******List Results********
'Clear output sheet
OutputSheet.Cells.Clear


'Set up titles
rResults.Value = "ID"
rResults.Offset(0, 1).Value = "Stage"
rResults.Offset(0, 2).Value = "Version"
rResults.Offset(0, 3).Value = "Date"

'Set rResults to start output next row
Set rResults = rResults.Offset(1, 0)



For Each key In dic.Keys
'Put ID in cell
rResults.Value = dic(key).ID

'Put Stage in cell.offset 1 col
rResults.Offset(0, 1).Value = dic(key).Stage

'Put Ver in cell.offset 2 cols
rResults.Offset(0, 2).Value = dic(key).Ver

'Put Date in cell.offset 3 cols
rResults.Offset(0, 3).Value = dic(key).EntryDate

'reference next cell (1 row down)
Set rResults = rResults.Offset(1, 0)
Next

'Show results
OutputSheet.Activate
End Sub


Private Function BuildDataRow(rStart As Range) As MyDataRow
Dim mdr As New MyDataRow
mdr.ID = rStart.Text
mdr.Stage = rStart.Offset(0, 1).Text
mdr.Ver = rStart.Offset(0, 2).Value
mdr.EntryDate = rStart.Offset(0, 3).Text
Set BuildDataRow = mdr
End Function


* Add a new WorkSheet & call it Results
* Now its done - Run macro GetIDs



"leolin" wrote in message
...
im trying to pick up the date with the highest version number for each stage
for each ID (there could be infinite versions). i have no idea where to
start!!

ID Stage Version # Date

169646 Feasibility 0 1/02/2005
169646 Conceptual 0 13/03/2005
169646 Definition + Design 0 1/04/2005
169646 Definition + Design 1 3/06/2005
169646 Build + Implement 0 5/07/2005
169646 Build + Implement 1 23/07/2005
169646 Build + Implement 2 12/08/2005
123497 Feasibility 0 1/09/2005
123497 Conceptual 0 25/10/2005
123497 Conceptual 1 4/11/2005

really appreciate your help here, thanks!