VBA to auto fill cells based on milestones and phases

Kevw1

New Member
Joined
Dec 6, 2017
Messages
36
Hi this is my first time posting and other then recording macros still very new to VBA but keen to learn, I have the following problem if anyone can help please? I have had a look in the forums and am struggling to utilise / find suitable code.

For summary only in table 1, this is my starting data, I have milestones that are against projects and months achieved for every milestone.

There are many more projects and months that span years in total, I need to convert the milestone to the Phase and populate the phase for the blank months until the next milestone is reached. In some cases milestones will be missing and may start half way through.

What I am trying to do is create a macro that:-
1. Check the value in the cell and matches to the milestone phase
2. If the cell is blank uses the previous milestone to calculate the phase
3. Repeat for every column against each project (many months over many years)
4. Repeat for each project
5. this can overwrite the data in the original sheet or creating a copy of the original sheet and update?
I will be changing the below "projects" and "Milestones" for actual data once I can understand the structure for this.

Table 2 show the results I am expecting, thanks again for any guidance where to start from.

[TABLE="width: 508"]
<colgroup><col><col span="4"><col><col><col></colgroup><tbody>[TR]
[TD="align: center"]Table 1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Project[/TD]
[TD="align: center"]Jun-17[/TD]
[TD="align: center"]Jul-17[/TD]
[TD="align: center"]Aug-17[/TD]
[TD="align: center"]Sep-17[/TD]
[TD="align: center"][/TD]
[TD="align: center"]Milestones[/TD]
[TD="align: center"]Phase[/TD]
[/TR]
[TR]
[TD="align: center"]Project 1[/TD]
[TD="align: center"]M1[/TD]
[TD="align: center"] [/TD]
[TD="align: center"] [/TD]
[TD="align: center"]M3[/TD]
[TD="align: center"][/TD]
[TD="align: center"]M1[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]Project 2[/TD]
[TD="align: center"]M1[/TD]
[TD="align: center"]M2[/TD]
[TD="align: center"]M3[/TD]
[TD="align: center"]M4[/TD]
[TD="align: center"][/TD]
[TD="align: center"]M2[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]Project 3[/TD]
[TD="align: center"] [/TD]
[TD="align: center"]M1[/TD]
[TD="align: center"] [/TD]
[TD="align: center"]M2[/TD]
[TD="align: center"][/TD]
[TD="align: center"]M3[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]Project 4[/TD]
[TD="align: center"]M1[/TD]
[TD="align: center"] [/TD]
[TD="align: center"] [/TD]
[TD="align: center"]M5[/TD]
[TD="align: center"][/TD]
[TD="align: center"]M4[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]Project 5[/TD]
[TD="align: center"]M2[/TD]
[TD="align: center"] [/TD]
[TD="align: center"] [/TD]
[TD="align: center"]M3[/TD]
[TD="align: center"][/TD]
[TD="align: center"]M5[/TD]
[TD="align: center"]3[/TD]
[/TR]
[TR]
[TD="align: center"]Project 6[/TD]
[TD="align: center"]M4[/TD]
[TD="align: center"] [/TD]
[TD="align: center"] [/TD]
[TD="align: center"]M5[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Table 2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Project[/TD]
[TD="align: center"]Jun-17[/TD]
[TD="align: center"]Jul-17[/TD]
[TD="align: center"]Aug-17[/TD]
[TD="align: center"]Sep-17[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Project 1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Project 2[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Project 3[/TD]
[TD="align: center"] [/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Project 4[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Project 5[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Project 6[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]

 
when running the macro now it is blanking all but 2 of the milestones,

I am updating
Range("B2:E" & UsdRws)
to B2:Z as this is the range currently in use and
For Each Cl In Range("G2", Range("G" & Rows.Count).End(xlUp))
"G2" to "AB3" and "G" to "AB" as this is where the Milestone and Phase data is stored otherwise not changing anything.
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Is the Phase data in col AC?
Also if your milestones are not M1, M2 etc then you'll need to change the value in red below, to your first milestone
Code:
If Len(Rng) = 0 And Not Rng.End(xlToRight) = "[COLOR=#ff0000]M1[/COLOR]" Then
 
Upvote 0
Hi yes the Phase data is in Col AC , Milestones in Col AB (headers are in row 2) with the first row of data in row 3, I have updated M1 to the first Milestone name (the name is "0-xxx" and each milestone starts with a number 0,01,02 etc then a text code if that could be an issue?), I have also tried moving the Phase table further away from the main data.

I have a test sheet I am running this in the workbook and copy and paste values from another sheet to reset the data before running the macro again, I have also copied the macro in to a new workbook and tried to run in that too, also tried the original code and that's not working now either it is only changing the existing milestones and not updating to the right the blank cells between milestones now.

The second code is blanking most of the data apart for 2-5 of the milestones, which keep changing each time i run the code.
 
Upvote 0
Are the blank cells actually blank, or do they have formulae returning "" ?
 
Upvote 0
I cannot replicate the problems you are encountering.
Would you be willing to upload your test book to OneDrive or dropbox, mark for sharing & post the link here?
 
Upvote 0
I have received the link thank you, but in order to conform to the rules, could you please also post the link to this thread?
 
Upvote 0
The problem is that your blanks weren't blank.
When you copy/paste formulae, if the formula returns "" then a nullstring will be pasted. If you try =ISBLANK(U2) in AA2, it will return False.
Try this version
Code:
Sub Milestones()

    Dim UsdRws As Long
    Dim DataRng As Range
    Dim Cl As Range
    Dim Rng As Range
    
    UsdRws = Range("A" & Rows.Count).End(xlUp).Row
    Set DataRng = Range("B2:Z" & UsdRws)
    With DataRng
        .Value = .Value
    End With
    
    For Each Rng In Range("B2:B" & UsdRws)
        If Len(Rng) = 0 And Not Rng.End(xlToRight) = "01-bbb" Then
            If WorksheetFunction.CountA(DataRng.Rows(Rng.Row - 1)) > 0 Then
                Range(Rng, Rng.End(xlToRight)).FillLeft
            End If
        End If
    Next Rng

    For Each Cl In Range("AD3", Range("AD" & Rows.Count).End(xlUp))
        DataRng.Replace Cl.Value, Cl.Offset(, 1).Value, xlWhole, , False, , False, False
    Next Cl
    
    On Error Resume Next
    DataRng.Columns(1).SpecialCells(xlBlanks).Value = "X"
    On Error GoTo 0
    With DataRng.Offset(, 1).Resize(, DataRng.Columns.Count - 1)
        On Error Resume Next
        .SpecialCells(xlBlanks).FormulaR1C1 = "=rc[-1]"
        On Error GoTo 0
        .Value = .Value
    End With
    DataRng.Replace "X", "", xlWhole, , , , False, False
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top