Conditional Formatting and VBA

[davidpierceatexcel]

HI all,
I have two questions I need some help with. I am creating a schedule and have two issues I have no idea how to format and or code. Here goes.

First:[/B] I want to conditionally format the following. When the finish date of a task is =< then today and the % complete cell is less than 100% then I want my cells TASK (B10) and % Complete (F10) to be highlighted Red as a notification.

=IF(Finishdate)=<(Today())AND(%COMPLETE)<100%,THEN
(TASK)AND(%COMPLETE), HIGHLIGHT RED
Finish Date = (E10)
Today = (TODAY)
%COMPLETE = (F10)
TASK = (B10)

Second: I have a WBS column and I have the code for that and works great. A big thanks to the designer. I want something VBA to update a starting date and update my dates in my workbook column C.

When I click button (ChStDate) or Change Start Date, I want a popup to come up, with the existing date in Cell (F2), a place to add a new date, and then have that calculate the number of days it has changed. Now, I need this to update many cells in column C which have a data format, MM/DD/YYYY, however I need it to only update the cells in column C with the WBS lines in level two and up. The level 1 dates in column C have other formulas and that will auto update by them selves. I have put my WBS code at below this for use if necessary.

I would really appreciate some assistance with this as this is a killer. I just don't get it, lOl!
Thank you in advance.
Dave


Sub WBSNumbering()

'From Project-Style (WBS) Numbering in MS Excel
'Renumber tasks on a project plan
'Associate this code with a button or other control on your spreadsheet

'Layout Assumptions:
'Row 1 contains column headings
'Column A contains WBS numbers
'Column B contains Task description, with appropriate indentation
'Some text (here we assume "END OF PROJECT") delimits the end of the task list

On Error Resume Next

'Hide page breaks and disable screen updating (speeds up processing)
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
'Format WBS column as text (so zeros are not truncated)
ActiveSheet.Range("A:A").NumberFormat = "@"
Dim r As Long 'Row counter
Dim depth As Long 'How many "decimal" places for each task
Dim wbsarray() As Long 'Master array holds counters for each WBS level
Dim basenum As Long 'Whole number sequencing variable
Dim wbs As String 'The WBS string for each task
Dim aloop As Long 'General purpose For/Next loop counter

r = 3 'Starting row
basenum = 0 'Initialize whole numbers
ReDim wbsarray(0 To 0) As Long 'Initialize WBS ennumeration array

'Loop through cells with project tasks and generate WBS
Do While Cells(r, 2) <> "END OF PROJECT"

'Ignore empty tasks in column B
If Cells(r, 2) <> "" Then

'Skip hidden rows
If Rows(r).EntireRow.Hidden = False Then

'Get indentation level of task in col B
depth = Cells(r, 2).IndentLevel

'Case if no depth (whole number master task)
If depth = 0 Then

'increment WBS base number
basenum = basenum + 1
wbs = CStr(basenum)
ReDim wbsarray(0 To 0)

'Case if task has WBS depth (is a subtask, sub-subtask, etc.)
Else

'Resize the WBS array according to current depth
ReDim Preserve wbsarray(0 To depth) As Long

'Repurpose depth to refer to array size; arrays start at 0
depth = depth - 1

'Case if this is the first subtask
If wbsarray(depth) <> 0 Then

wbsarray(depth) = wbsarray(depth) + 1

'Case if we are incrementing a subtask
Else

wbsarray(depth) = 1

End If

'Only ennumerate WBS as deep as the indentation calls for;
'so we clear previous stored values for deeper levels
If wbsarray(depth + 1) <> 0 Then
For aloop = depth + 1 To UBound(wbsarray)
wbsarray(aloop) = 0
Next aloop
End If

'Assign contents of array to WBS string
wbs = CStr(basenum)

For aloop = 0 To depth
wbs = wbs & "." & CStr(wbsarray(aloop))
Next aloop

End If

'Populate target cell with WBS number
Cells(r, 1).Value = wbs

'Get rid of annoying "number stored as text" error
Cells(r, 1).Errors(xlNumberAsText).Ignore = True

'Apply text format: next row is deeper than current
If Cells(r + 1, 2).IndentLevel > Cells(r, 2).IndentLevel Then

Cells(r, 1).Font.Bold = True
Cells(r, 2).Font.Bold = True
'Else (next row is same/shallower than current) no format
Else
Cells(r, 1).Font.Bold = False
Cells(r, 2).Font.Bold = False
End If
'Special formatting for master (whole number) tasks)
If Cells(r, 2).IndentLevel = 0 Then
Cells(r, 1).Font.Bold = True
Cells(r, 2).Font.Bold = True
'Add whatever other formatting you want here

End If

End If

End If

'Go to the next row
r = r + 1

Loop

End Sub