Functions or VBA to improve trackers

[andre3000]

Hi,

I am currently working on making it easier to track projects and calculating the days each project goes over the agree time.I would like to produce a 4 box model but unsure of the best way to do this. I have set up forecast date and completion dates already but would like this in a graphical format to see timelines etc. I would like to find out the best way to measure the # of total projects on time and # total projects delayed etc.

At the moment, as team members are filling it in it can be vulnerable to human error i.e. wrong format of date and sometimes somehow they misspell their name even though I have a data validation list (sheet 1). I have set up some VBA code (below - could not attach the file due to an image- how do I get rid of ths setting) to do some of it but what I would like is in steps:

1) ask them to enter the project name,
2) ask why stage is it; feasibility, evaluation, final etc
3) then from there enter the relevant dates,
4) Latest issue,
5) author (from a list) and so on. not sure if you can produce a data validation list in vba.

I would also like the projects to be in automatically ordered by alphabet

I need some help with this to make it sleek. I have attached the sheet.

Thanks in advance.

Sub addproject()

Dim rownum As Long
Dim strDate As String
Dim stage As String
 
rownum = 4


'find empty row
Do Until Cells(rownum, 1).Value = ""
rownum = rownum + 1
Loop


'populate Project no. and Current Stage
Cells(rownum, 1).Value = InputBox("Enter Project Name")


stage = InputBox("Enter Stage")
If stage = "EVALUATION" Or stage = "FEASIBILITY" Or stage = "EVALUATION" Or stage = "FINAL" Then
Cells(rownum, 2).Value = stage
Else
GoTo err:
End If


'ask user to enter date and check it is in dd/mm/yyyy format
strDate = InputBox("Insert Baseline Date in format dd/mm/yy", "User date", Format(Now(), "dd/mm/yy"))


  If IsDate(strDate) Then
    strDate = Format(CDate(strDate), "dd/mm/yy")
    Cells(rownum, 3).Value = strDate
  Else
    MsgBox "Wrong date format"
    GoTo err:
  End If
  
'copy format of above row
    Rows(rownum - 1).Copy
    Rows(rownum).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
  
Exit Sub


'delete row if there is an error
err:
MsgBox "Incorrect Input Added"
Rows(rownum).Delete
  
End Sub