Modify existing code to dynamic code

[Ixtreme]

Hello,

I have the following code to retrieve the next upcoming action. The
code works fine and does exactly what I want. However, I have lots of
projects listed in columns and want this formula to be listed under
each project.

The sheet looks like this:

columnA columnB columnC Column
D Column E
Project
A Project B
Phase 1 30-08-2007 Pending
1-10-2007 Pending
Phase 2 04-09-2007 Open
1-08-2007 Draft
Phase 3 01-01-2007 Finished
1-12-2007 Open
Phase X 13-10-2007 Cancelled
13-12-2007 Open

------> function Phase 1, Pending, 0
days Phase2, Draft, -29 Days



Function EarliestAction(ParamArray actions() As Variant) As String

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

First = True
EarlistRow = 0
Found = False
For RowCount = 1 To LastRow
For action = 0 To UBound(actions())
If Cells(RowCount, "C") = actions(action) Then
If First = True Then
EarlistRow = RowCount
Found = True
First = False
Exit For
Else
If Cells(RowCount, "B") < _
Cells(EarlistRow, "B") Then

EarlistRow = RowCount
Exit For
End If
End If

End If
Next action
Next RowCount
If Found = True Then
If Cells(EarlistRow, "B") > Now() Then
days = Int(Cells(EarlistRow, "B") - Now())
Else
days = Int(Now() - Cells(EarlistRow, "B"))
End If
EarliestAction = Cells(EarlistRow, "A") & _
", " & Cells(EarlistRow, "C") & ", " & _
days
If days = 1 Then
EarliestAction = EarliestAction & " day"
Else
EarliestAction = EarliestAction & " days"
End If

Else
EarliestAction = ""
End If

 

[Guest]

I love modifying my own code. I added a new parameter into the parameter
list. for the first project simply put in A1 or the sttartiong column of the
table. For the next project put in D1 or which ever column the table starts.

Function EarliestAction(startcell As Range, ParamArray actions() As Variant)
As String

LastRow = Cells(Rows.Count, startcell.Column + 1).End(xlUp).Row

First = True
EarlistRow = 0
Found = False
For RowCount = 1 To LastRow
For action = 0 To UBound(actions())
If Cells(RowCount, startcell.Column + 2) = actions(action) Then
If First = True Then
EarlistRow = RowCount
Found = True
First = False
Exit For
Else
If Cells(RowCount, startcell.Column + 1) < _
Cells(EarlistRow, startcell.Column + 1) Then

EarlistRow = RowCount
Exit For
End If
End If

End If
Next action
Next RowCount
If Found = True Then
If Cells(EarlistRow, startcell.Column + 1) > Now() Then
days = Int(Cells(EarlistRow, startcell.Column + 1) - Now())
Else
days = Int(Now() - Cells(EarlistRow, startcell.Column + 1))
End If
EarliestAction = Cells(EarlistRow, startcell.Column) & _
", " & Cells(EarlistRow, startcell.Column + 2) & ", " & _
days
If days = 1 Then
EarliestAction = EarliestAction & " day"
Else
EarliestAction = EarliestAction & " days"
End If

Else
EarliestAction = ""
End If

End Function

 

[Ixtreme]

I love modifying my own code. I added a new parameter into the parameter
list. for the first project simply put in A1 or the sttartiong column of the
table. For the next project put in D1 or which ever column the table starts.

Function EarliestAction(startcell As Range, ParamArray actions() As Variant)
As String

LastRow = Cells(Rows.Count, startcell.Column + 1).End(xlUp).Row

First = True
EarlistRow = 0
Found = False
For RowCount = 1 To LastRow
For action = 0 To UBound(actions())
If Cells(RowCount, startcell.Column + 2) = actions(action) Then
If First = True Then
EarlistRow = RowCount
Found = True
First = False
Exit For
Else
If Cells(RowCount, startcell.Column + 1) < _
Cells(EarlistRow, startcell.Column + 1) Then

EarlistRow = RowCount
Exit For
End If
End If

End If
Next action
Next RowCount
If Found = True Then
If Cells(EarlistRow, startcell.Column + 1) > Now() Then
days = Int(Cells(EarlistRow, startcell.Column + 1) - Now())
Else
days = Int(Now() - Cells(EarlistRow, startcell.Column + 1))
End If
EarliestAction = Cells(EarlistRow, startcell.Column) & _
", " & Cells(EarlistRow, startcell.Column + 2) & ", " & _
days
If days = 1 Then
EarliestAction = EarliestAction & " day"
Else
EarliestAction = EarliestAction & " days"
End If

Else
EarliestAction = ""
End If

End Function















- Tekst uit oorspronkelijk bericht weergeven -

Hi Joel,

Sorry for not mentioning your name. Could you change your code again a
bit so that each project is always looking at column A for the
actions? So in A I have a list of actions and in B a date, C the
status, D a date (second project), C the status (second project) etc.

Thanks again!

Mark

 

[Guest]

Use B1 as first parameter for first project, then use first column of each
project for the other projects.. column A is automatically referrenced in
the code.


Function EarliestAction(startcell As Range, _
ParamArray actions() As Variant) As String

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

First = True
EarlistRow = 0
Found = False
For RowCount = 1 To LastRow
For action = 0 To UBound(actions())
If Cells(RowCount, startcell.Column + 1) = actions(action) Then
If First = True Then
EarlistRow = RowCount
Found = True
First = False
Exit For
Else
If Cells(RowCount, startcell.Column) < _
Cells(EarlistRow, startcell.Column) Then

EarlistRow = RowCount
Exit For
End If
End If

End If
Next action
Next RowCount
If Found = True Then
If Cells(EarlistRow, startcell.Column) > Now() Then
days = Int(Cells(EarlistRow, startcell.Column) - Now())
Else
days = Int(Now() - Cells(EarlistRow, startcell.Column))
End If
EarliestAction = Cells(EarlistRow, "A") & _
", " & Cells(EarlistRow, startcell.Column + 1) & ", " & _
days
If days = 1 Then
EarliestAction = EarliestAction & " day"
Else
EarliestAction = EarliestAction & " days"
End If

Else
EarliestAction = ""
End If

End Function

 

[Ixtreme]

Joel,

I receive the following error if I enter =EarliestAction(B1;"In
Progress";"Draft";"Pending")

Microsoft cannot calculate a formula. There is a circular reference in
an open workbook, but the references that cause is cannot be listed
for you. Try editing the last formula you entered or removing it with
the Undo command(Edit menu).

Do you have any idea why this happens? I could send you the file if
you want. Just let me know ok?

Thanks,

Mark

 

[Guest]

Yes

(e-mail address removed)