VBA to auto fill cells based on milestones and phases

K

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]

​
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
Hi & welcome to the board.
How about
Code: 
Sub Milestones()

    Dim UsdRws As Long
    Dim DataRng As Range
    Dim Cl As Range
    
    UsdRws = Range("A" & Rows.Count).End(xlUp).Row
    Set DataRng = Range("B2:E" & UsdRws)
    For Each Cl In Range("G2", Range("G" & Rows.Count).End(xlUp))
        DataRng.Replace Cl.Value, Cl.Offset(, 1).Value, xlWhole, , False, , False, False
    Next Cl
    With DataRng.Offset(, 1).Resize(, DataRng.Columns.Count - 1)
        .SpecialCells(xlBlanks).FormulaR1C1 = "=rc[-1]"
        .Value = .Value
    End With
    
End Sub
 
Upvote 0
Hi Fluff, thanks for the fast reply, almost working I just have 2 problems at the moment,

1. For the fill of the data I was hoping to get the phase (1,2,3) returned currently it is returning the Milestone (M1, M2, M3 etc) but I can work with that gets me 3/4 there,
2. I did not mention this before as did not realise, but I also need it to fill the previous cells with the phase too based on the known milestone, currently it only fills forwards of the milestone, example

[TABLE="class: cms_table, width: 508"]
<tbody style="border-collapse: collapse; border-spacing: 0px 0px; font-size: 13px; margin-bottom: 0px;">[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"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]M1[/TD]
[TD="align: center"]M3[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="class: cms_table, width: 508"]
<tbody style="border-collapse: collapse; border-spacing: 0px 0px; font-size: 13px; margin-bottom: 0px;">[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"]3[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Hi, I just spotted one more exception to the above Milestone 1 does not need to be filled to the left as this is the start of the process, thanks
 
Upvote 0
If your milestones are in Col G with the phase in Col H, it should replace the milestone, with the phase in the main data.
The next part is a bit more tricky.
 
Upvote 0
[TABLE="class: cms_table_cms_table, width: 508"]
<tbody style="border-collapse: collapse; border-spacing: 0px 0px; font-size: 13px; margin-bottom: 0px;">[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"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]M2[/TD]
[TD="align: center"]M5[/TD]
[/TR]
</tbody>[/TABLE]


[TABLE="class: cms_table_cms_table, width: 508"]
<tbody style="border-collapse: collapse; border-spacing: 0px 0px; font-size: 13px; margin-bottom: 0px;">[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"]3[/TD]
[/TR]
</tbody>[/TABLE]
​

this is the correct example of left fill, M1 is a hard stop.
 
Upvote 0
Hi, I have the correct Phase now showing thanks I had linked to the wrong column when adapting for actual data. just the tricky left fill, but this is great help so far been struggling on an off for the last week in Excel so thought time to move to VBA.
 
Upvote 0
OK, I've got to pop out for a bit, but will have a look when I get back
 
Upvote 0
Thanks, also just trying on new copy of the data and now getting error message 1004, against
.SpecialCells(xlBlanks).FormulaR1C1 = "=rc[-1]"​
I have to go soon too, so may not be back online till tomorrow.
 
Upvote 0
Slight change of plan (I couldn't be bothered to go shopping).
Give this a go. It also takes into account post#9
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:E" & UsdRws)
    
    For Each Rng In Range("B2:B" & UsdRws)
        If Len(Rng) = 0 And Not Rng.End(xlToRight) = "M1" Then
            Range(Rng, Rng.End(xlToRight)).FillLeft
        End If
    Next Rng

    For Each Cl In Range("G2", Range("G" & 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
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Assign Month number 1 to n based on sequential week range
Replies
6
Views
468
amolvijay
A
B
  • Question Question
Suggestions for Building a Historical Cost Database by Project
Replies
0
Views
56
babyjwhale
B
Deepakchoudhary
  • Solved
RANK based on selling multiple items in different criteria (Excel 2016)
Replies
3
Views
147
hagia_sofia
hagia_sofia
V
  • Question Question
Filter or any other function for filter the data
Replies
8
Views
176
Fuji
F
C
  • Question Question
Automate a data table into a Gannt Chart
Replies
1
Views
489
Cantrecallmyusername
C

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

Share this page

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