Auto Update Rows in One Sheet from Another

The only way i can see this happen without any issues is when the code re-creates the Status sheet each time you run the macro.

Will this work for you?

Try this code

Option Explicit

Sub update_status()
Dim lrow As Long, i As Long, a As Long

With Worksheets("Status")
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = 4 To lrow
        If .Range("B" & i).Value <> "Risk" Then
            .Range("B" & i).Value = ""
        End If
    Next i
End With

a = 4
With Worksheets("Issue Log")
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If .Range("G" & i).Value = "Open" And .Range("H" & i).Value = "Critical" Then
            If Worksheets("Status").Range("B" & a + 2).Value = "Risk" Then
                Worksheets("Status").Rows(a).Insert
            End If
            Worksheets("Status").Range("B" & a).Value = .Range("D" & i).Value
            a = a + 1
        End If
    Next i
End With

With Worksheets("Status")
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = 4 To lrow
        If .Range("B" & i).Value = "Risk" Then
            a = i + 1
            Exit For
        End If
    Next i
End With

With Worksheets("Risk Tracker")
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If .Range("G" & i).Value = "Critical" Then
            If Worksheets("Status").Range("B" & a + 1 & ":M" & a + 1).MergeCells = False Then
                Worksheets("Status").Rows(a).Insert
            End If
            Worksheets("Status").Range("B" & a).Value = .Range("D" & i).Value
            a = a + 1
        End If
    Next i
End With

End Sub

Copy the Excel VBA code
Select the workbook in which you want to store the Excel VBA code
Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
Choose Insert | Module
Where the cursor is flashing, choose Edit | Paste

To run the Excel VBA code:
Choose View | Macros
Select a macro in the list, and click the Run button

Couple of observations

1. Make all the updates to the Issue Log and Risk Tracker and then run the macro.
2. The conditions for the Issue Log are column G=Open and Column H=Critical.
3. The conditions for the Risk Tracker are column G=Critical

Let me know if anything needs to be changed.

This was a great first go at it! The issue update looks to be running great, but there were a few issues with the risks update ... See below:

1) I forgot to add the Status column to the risk tracker sheet. If that could be added to the criteria that would be great.
2) If you run the macro multiple times the updates to risk tracker on the status page will continuously add empty rows. After about the fifth run of the macro it acts funky and begins to insert rows formatted like the header. If you hit the macro enabled button 5 times you will see what I mean.

I've attached a copy of the workbook with the macro created for your reference. Thank you so much for you help on this. It's so close!

TJH

One last question:

In the future, if I want to add another section (Action) to status pulling from a new worksheet (Action Items) based off of the same criteria as the other sheet how do I need to go about adding that to the macro?

Example file attached

Thanks again,
TJH

Ok, i will need to work out the logic a lil more in detail since its inserting blank rows. Will update you shortly.

I will have something ready for you by tomorrow.

This is the updated code

Option Explicit

Sub update_status()
Dim lrow As Long, i As Long, a As Long

With Worksheets("Status")
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = 4 To lrow
        If .Range("B" & i).Value <> "Risk" Then
            .Range("B" & i).Value = ""
        End If
    Next i
End With

a = 4
With Worksheets("Issue Log")
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If .Range("G" & i).Value = "Open" And .Range("H" & i).Value = "Critical" Then
            If Worksheets("Status").Range("B" & a + 2).Value = "Risk" Then
                Worksheets("Status").Rows(a).Insert
            End If
            Worksheets("Status").Range("B" & a).Value = .Range("D" & i).Value
            a = a + 1
        End If
    Next i
End With

With Worksheets("Status")
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = 4 To lrow
        If .Range("B" & i).Value = "Risk" Then
            a = i + 1
            Exit For
        End If
    Next i
End With

With Worksheets("Risk Tracker")
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If .Range("G" & i).Value = "Critical" And .Range("I" & i).Value = "Open" Then
            If Worksheets("Status").Range("B" & a + 1 & ":M" & a + 1).MergeCells = False Then
                Worksheets("Status").Rows(a).Insert
            End If
            Worksheets("Status").Range("B" & a).Value = .Range("D" & i).Value
            a = a + 1
        End If
    Next i
End With
End Sub

Observations
The reason why the wrong format was duplicating was because of some unmerged cells after row 13. Ensure that the rows required to be merged are merged properly.
If you want to duplicate the code for Action Items, just copy this part of the code again

With Worksheets("Status")
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = 4 To lrow
        If .Range("B" & i).Value = "Risk" Then
            a = i + 1
            Exit For
        End If
    Next i
End With

With Worksheets("Risk Tracker")
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If .Range("G" & i).Value = "Critical" And .Range("I" & i).Value = "Open" Then
            If Worksheets("Status").Range("B" & a + 1 & ":M" & a + 1).MergeCells = False Then
                Worksheets("Status").Rows(a).Insert
            End If
            Worksheets("Status").Range("B" & a).Value = .Range("D" & i).Value
            a = a + 1
        End If
    Next i
End With

Make the required corrections like changing

If .Range("B" & i).Value = "Risk" Then

to

If .Range("B" & i).Value = "Action" Then

Here is the updated code

Option Explicit

Sub update_status()
Dim lrow As Long, i As Long, a As Long

With Worksheets("Status")
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = 4 To lrow
        If .Range("B" & i).Value <> "Risk" And .Range("B" & i).Value <> "Action" Then
            .Range("B" & i).Value = ""
        End If
    Next i
End With

a = 4
With Worksheets("Issue Log")
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If .Range("G" & i).Value = "Open" And .Range("H" & i).Value = "Critical" Then
            If Worksheets("Status").Range("B" & a + 2).Value = "Risk" Then
                Worksheets("Status").Rows(a).Insert
            End If
            Worksheets("Status").Range("B" & a).Value = .Range("D" & i).Value
            a = a + 1
        End If
    Next i
End With

With Worksheets("Status")
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = 4 To lrow
        If .Range("B" & i).Value = "Risk" Then
            a = i + 1
            Exit For
        End If
    Next i
End With

With Worksheets("Risk Tracker")
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If .Range("I" & i).Value = "Critical" And .Range("H" & i).Value = "Open" Then
            If Worksheets("Status").Range("B" & a + 2).Value = "Action" Then
                Worksheets("Status").Rows(a).Insert
            End If
            Worksheets("Status").Range("B" & a).Value = .Range("D" & i).Value
            a = a + 1
        End If
    Next i
End With

With Worksheets("Status")
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = 4 To lrow
        If .Range("B" & i).Value = "Action" Then
            a = i + 1
            Exit For
        End If
    Next i
End With

With Worksheets("Action Items")
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If .Range("I" & i).Value = "Critical" And .Range("H" & i).Value = "Open" Then
            If Worksheets("Status").Range("B" & a + 1 & ":M" & a + 1).MergeCells = False Then
                Worksheets("Status").Rows(a).Insert
            End If
            Worksheets("Status").Range("B" & a).Value = .Range("D" & i).Value
            a = a + 1
        End If
    Next i
End With
End Sub

If there is any row that is unmerged in the last section, it creates an issue for the macro.

Can we fix on a particular row count for the last section? For e.g. can we say that if the number of allotted rows for Action is 10 and the no of entries is 11, then the macro needs to insert a row and put the value in.

If not, you just have to ensure that the required rows in each section (specially Action) are merged before you run the macro.

Looking at your new format, i dont think we can go with the "merged cells" concept to understand if we need to insert more rows, because you have the "Date Identified" column which needs to be populated too.

I guess, we will have to go with a fixed number of rows for each section. For e.g. We will need to fix the number of rows as say 8 or 10. The macro then needs to check if the number of rows are enough to populate the data, if yes proceed, if no, insert rows and then proceed.

Where is the date column in each tab that needs to be pulled up into the main sheet?

Try this code and let me know if anything needs to be changed. I have not used the 12 rows per section logic but made the report a lil flexible.

Option Explicit

Sub update_status()
Dim lrow As Long, i As Long, a As Long
Dim ws As Worksheet

With Worksheets("Status")
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    If lrow > 3 Then .Rows("4:" & lrow).Delete
    
    Set ws = Worksheets("Issue Log")
    lrow = ws.Range("C" & Rows.Count).End(xlUp).Row
    a = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If ws.Range("G" & i).Value = "Open" And ws.Range("H" & i).Value = "Critical" Then
            .Range("B" & a + 1).Value = ws.Range("B" & i).Value
            .Range("C" & a + 1).Value = ws.Range("D" & i).Value
            .Range("D" & a + 1).Value = ws.Range("E" & i).Value
            a = a + 1
        End If
    Next i
    
    .Range("B3:D3").Copy .Range("B" & a + 2)
    .Range("C" & a + 2).Value = "Risk"
    a = .Range("B" & .Rows.Count).End(xlUp).Row
    
    Set ws = Worksheets("Risk Tracker")
    lrow = ws.Range("C" & Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If ws.Range("G" & i).Value = "Open" And ws.Range("H" & i).Value = "Critical" Then
            .Range("B" & a + 1).Value = ws.Range("B" & i).Value
            .Range("C" & a + 1).Value = ws.Range("D" & i).Value
            .Range("D" & a + 1).Value = ws.Range("E" & i).Value
            a = a + 1
        End If
    Next i
    
    .Range("B3:D3").Copy .Range("B" & a + 2)
    .Range("C" & a + 2).Value = "Milestones"
    a = .Range("B" & .Rows.Count).End(xlUp).Row
    
    Set ws = Worksheets("Milestones")
    lrow = ws.Range("C" & Rows.Count).End(xlUp).Row
    For i = 3 To lrow
        If ws.Range("G" & i).Value = "Open" And ws.Range("H" & i).Value = "Critical" Then
            .Range("B" & a + 1).Value = ws.Range("B" & i).Value
            .Range("C" & a + 1).Value = ws.Range("D" & i).Value
            .Range("D" & a + 1).Value = ws.Range("E" & i).Value
            a = a + 1
        End If
    Next i
    
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    With .Range("B4:D" & lrow)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    
    .Columns("C:C").WrapText = True
    
End With
    
End Sub

I used the copy in post 20.

What is the runtime error and which line is highlighted?