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]

​
 
Sort by date Sort by votes
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

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
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
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
57
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,337
Members
452,637
Latest member
Ezio2866

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