How do i do a loop which is verifying that cells in the same column are numeric until the last cell which will be determined by an empty cell?
Thanks so much
Hi Lynton 1,
You'll have to adapt this to your own needs as you weren't specific regarding which column.
Sub FindNumeric() Dim wS As Worksheet Dim oC As Range 'Loop through Column A and if numeric, 'place the string "Numeric" in cell adjacent 'in column B. Set wS = ActiveSheet For Each oC In wS.Range(wS.Cells(2, 1), wS.Cells(wS.Rows.Count, 1).End(xlUp)) If IsNumeric(oC.Value) Then oC.Offset(0, 1).Value = "Numeric" Else oC.Offset(0, 1).Value = "" End If Next oC End Sub
Please Could Someone Help Me With some VBA coding. I have project To determine the critical path Method (details below), I have attempted to do the majority of the coding however i am not sure how correct it is,. I would be very grateful if someone could help me as well as add some coding to determine the Critical path which works in conjunction with the Table attached.
Structure of the VBA code and rules guiding the determination of a project’s critical path:
o 1 main macro that calls/activates all the macros below.
o 1 macro that catches and reports on all incorrect entries into columns A, C, D, E, F, G and H of Worksheet “Data” (i.e. Table 1).
o 1 macro that calculates the Early Start (ES) and Early Finish (EF) dates for all activities using the Forward Pass method described below:
ES is the earliest date by which an activity can start assuming all the preceding activities are
completed as planned.
Hence, by default, ESThe first activity = 1 (i.e. the first day of the project) For other activities, ESActivity B = EFActivity A + 1
EF is the earliest date by which an activity can be completed assuming all the preceding activities are completed as planned. Therefore,
EFActivity A = ESActivity A + DurationActivity A – 1
When many activities lead into one activity in the Forward Pass method, chose the highest EF date
to calculate the ES date for the succeeding activity
o 1 macro that calculates the Late Start (LS) and Late Finish (LF) dates for all activities using the
Backward Pass method described below:
LF is the latest date an activity can finish in order to meet the planned completion date. Hence, by default, LFThe last activity = EFThe last activity (i.e. the last day of the project) For other activities, LFActivity A = EFActivity B – 1
LS is the latest date an activity can start in order to meet the planned completion date. Therefore,
LSActivity A = LFActivity A - DurationActivity A + 1
When many activities lead into one activity in the Backward Pass method, chose the lowest LS date
to calculate the LF date for the preceding activity.
1 macro that calculates the Float for all the activities and indicates the activities on the Project’s
Critical Path. Float indicates how many days an activity can be delayed or extended before it will affect the completion date of the project or any target finish dates.
Therefore, Float = LF - EF or LS - ES
The Critical Path is the path containing activities with the minimum float (in this project, the
Critical Path is the path containing activities with zero float).
Heres the Coding i have so far
Public Type ActType Number As Integer Name As Integer Nsucc As Integer Npred As Integer Pred(999) As Variant Succ(999) As Variant End Type Sub CPM() 'Macro for Critical Path Method Dim Acts(999) As ActType Set dataReg1 = [A3].CurrentRegion nActive = dataReg1.Rows.Count - 1 NPreds = dataReg1.Columns.Count - 2 Set AN = dataReg1.Columns(1) Set Dur = dataReg1.Columns(3) For i = 1 To nActive 'Check for non-numeric Activity Numbers If Not (Application.Worksheets(1).IsNumeric(["A3"]).Offset(i, 0)) Then MsgBox ("Non-Numeric Data in cell " & [A3].Offset(i, 0).Address & ".") Style = vbOKOnly + vbDefaultButton1 + vbExclamation 'Defining the buttons on Message box Title = "INPUT ERROR for CPM Macro" 'Define message box Title Response = MsgBox(msg, Style, Title, Help, Ctxt) Application.ScreenUpdating = True Exit Sub End If Next i For i = 1 To nActive 'Read and Intitialize Activities With Acts(i) .Number = 0 .Npred = 0 .Nsucc = 0 .Name = Data.Reg.Cells(i + 1, 2) End With Next i For i = 1 To nActive 'Go through Predecessor lists With Acts(i) For j = 1 To NPreds If DataReg.Cells(i + 1, j + 4) <> "" Then Problem = True For k = 1 To nActive If Acts(k).Name = DataReg.Cells(i + 1, j + 4) Then Problem = False .Npred = .Npred + 1 .Pred(j) = k End If Next k If Problem Then MsgBox ("Error.Activity " & DataReg.Cells(i + 1, 1) & " Activity 1 has a predecessor" & Data.Reg.Cells(i + 1, j + 4) & _ "This is not a correct activity number.") Application.ScreenUpdating = True Exit Sub End If End If Next j End With Next i ActNo = 1 'Put Activities in a logical Order LoopX: OldActNo = ActNo done = True For i = 1 To nActive With Acts(i) If .Number > 0 Then GoTo LoopA If .Npred = 0 Then GoTo LoopB For j = 1 To .Npred k = .Pred(j) If Acts(k).Number = 0 Then done = False GoTo LoopA End If Next j LoopB: .Number = ActNo ActNo = ActNo + 1 LoopA: End With Next i If ActNo = OldActNo Then MsgBox ("The Network Has a Loop") Application.ScreenUpdating = True Exit Sub End If If Not (done) Then GoTo LoopX For i = 1 To nActive ' Make a Successor List For j = 1 To Acts(i).Npred m = Acts(i).Pred(j) With Acts(m) .Nsucc = .Nsucc + 1 .Succ(.Nsucc) = i End With Next j Next i MaxSucc = 0 For i = 1 To nActive If Acts(i).Npred > MaxSucc Then MaxSucc = Acts(i).Npred Next i For i = 1 To nActive 'Write a Successor List For j = 1 To Acts(i).Nsucc m = Acts(i).Succ(j) sucAddress = "=" & Data.Reg.Cells(m + 1, 1).Address(rowabsolute:=False, columnabsolute:=False) dataReg1.Offset(i, 8 + j) = sucAddress Next j Next i m = (nActive + 9) 'Writing in the formulas dataReg1.FormulaR1C1 = Acts(j).Dur For i = 1 To nActive dataReg1.Offset(i, 0).FormulaR1C1 = Acts(i).Number ' Logical order of Activity Number dataReg1.Offset(i, 10).FormulaR1C1 = "=RC[-1]+R[-8]-1" 'EF=ES+Duration-1 dataReg1.Offset(i, 11).FormulaR1C1 = "=RC-R[-9]+1" 'LS=LF-Duration +1 dataReg1.Offset(i, 13).FormulaR1C1 = "RC[-2]-RC[-4]" 'Float=LS-ES For i = 1 To nActive 'Formula for ES time If Acts(i).Npred = 0 Then DataReg.Offset(i, 1).Formula = "=" & StartLoc Else txt = "=Max(" For j = 1 To Acts(i).Npred m = Acts(i).Pred(j) If j > 1 Then txt = txt & "," txt = txt & dataReg1.Offset(m, 3).Address(rowabsolute:=False, columnabsolute:=False) Next j txt = txt & ")" dataReg1.Offset(i, 1).Formula = txt End If Next i For i = 1 To nActive 'Formula for LF time If Acts(i).Nsucc = 0 Then dataReg1.Offset(i, 12).Formula = "=" & EndLoc Else txt = "Min(" For j = 1 To Acts(i).Nsucc m = Acts(i).Succ(j) If j > 1 Then txt = txt & "." txt = txt & dataReg1.Offset(m, 11).Formula = txt End If Next i End Sub
Thanks so much
What about your previous problem?
This is the project my previous problem was a small part of
To start, that is way too much criteria regarding things that only you know about. I'm not even sure what you mean by forward pass and backward pass methods. I don't know how the code that you have provided us relates to the requirements listed above.
What I suggest is that you post a mock workbook with some sample data. Provide before code and after code scenarios along with descriptions of what should be happening. Also, lets take this in steps, it will be better for you and better for me or anyone else who may jump in to help.