Two part problem: 1- If a cell in a column in blank, return value in a cell in the same row, but different column

[excellearner17]

Second part is based on the row number of the returned cell value, match other two columns. Maybe an example will make this more clear:

From the raw data I want to extract the program name whenever there is no responsible person assigned (cell blank), After I want to be able to match the sub-program and task with the right program
Key facts:
- The list is long, so I need a formula that can continue to scan down, even if more rows are added
- The raw data and output will be in separate tabs

Raw data[TABLE="width: 500"]
<tbody>[TR]
[TD]Program[/TD]
[TD]Sub-program[/TD]
[TD]Task[/TD]
[TD]Responsible person[/TD]
[/TR]
[TR]
[TD]Office
[/TD]
[TD]Supplies[/TD]
[TD]Contact suppliers[/TD]
[TD]Kevin
[/TD]
[/TR]
[TR]
[TD]Office[/TD]
[TD]Supplies[/TD]
[TD]Pay suppliers[/TD]
[TD]Jessica[/TD]
[/TR]
[TR]
[TD]Office[/TD]
[TD]Recruitment[/TD]
[TD]Contact agencies[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Home[/TD]
[TD]*******[/TD]
[TD]Monthly shopping[/TD]
[TD]Paul[/TD]
[/TR]
</tbody>[/TABLE]

Output
[TABLE="width: 500"]
<tbody>[TR]
[TD]Program[/TD]
[TD]Sub-program[/TD]
[TD]Task[/TD]
[/TR]
[TR]
[TD]Office[/TD]
[TD]Recruitment[/TD]
[TD]Contact agencies[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Any help much much appreciated!
****** id="cke_pastebin" style="position: absolute; top: 214.667px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">[TABLE="width: 500"]
<tbody>[TR]
[TD]Program[/TD]
[TD]Sub-program[/TD]
[TD]Task[/TD]
[/TR]
</tbody>[/TABLE]


</body>

 

[mumps]

The macro assumes that your raw data is in Sheet1 and copying will be done to Sheet2. Change the sheet names to suit your needs.

Sub ReturnVal()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Sheet1").Range("A1:D" & LastRow).AutoFilter Field:=4, Criteria1:="="
    Sheets("Sheet1").Range("A2:D" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1, 0)
    If Sheets("Sheet1").AutoFilterMode = True Then Sheets("Sheet1").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

 

[D3allamerican07]

excellearner17,

I would suggest a simple macro for this problem rather than a formula. My suggestion is to create a button on the output sheet and click it every time you would like to find this information. To ensure there are not errors, make sure the sheet names match those in the code, or change accordingly.

Sub Test()

    rawdataLR = Sheets("[B]Raw Data[/B]").Range("A" & Rows.Count).End(xlUp).Row
    outputLR = Sheets("[B]Output[/B]").Range("A" & Rows.Count).End(xlUp).Row
    
    'Clear Output sheets so no duplicate values are added
    If outputLR > 1 Then
        Sheets("[B]Output[/B]").Range("A2:C" & outputLR).ClearContents
    End If
    
    'Place blank raw data in output sheet
    For Each cell In Sheets("[B]Raw Data[/B]").Range("D2:D" & rawdataLR)
        If cell.Value = "" Then
            With Sheets("[B]Output[/B]")
                LR = Sheets("[B]Output[/B]").Range("A" & Rows.Count).End(xlUp).Row
                
                .Range("A" & LR + 1).Value = Sheets("[B]Raw Data[/B]").Range("A" & cell.Row).Value
                .Range("B" & LR + 1).Value = Sheets("[B]Raw Data[/B]").Range("B" & cell.Row).Value
                .Range("C" & LR + 1).Value = Sheets("[B]Raw Data[/B]").Range("C" & cell.Row).Value
            End With
        End If
    Next cell

End Sub

Let me know if you need help figuring out how to run this.

Bill

 

[mumps]

Sorry..a minor change:

Sub ReturnVal()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Sheet2").UsedRange.ClearContents
    Sheets("Sheet1").Rows(1).EntireRow.Copy Sheets("Sheet2").Cells(1, 1)
    Sheets("Sheet1").Range("A1:D" & LastRow).AutoFilter Field:=4, Criteria1:="="
    Sheets("Sheet1").Range("A2:D" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1, 0)
    If Sheets("Sheet1").AutoFilterMode = True Then Sheets("Sheet1").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

 

[excellearner17]

Hi Bill and Mumps,

Thank you for your prompt response. Maybe one thing I should have mentioned - This workbook will later be shared with other people, so I need a formula rather than a button. Is this possible?
Also my experience with Macros is non-existent, so if there is a formula to do this I would prefer it (as I can later explain to the people I am sharing it with)
Cheers!

 

[mumps]

I don't know about a formula but a macro would be easier for other people because all they would have to do is click a button. The macro is also flexible in that if you add more row it takes that into account automatically. If you want to give it a try, do the following: Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the menu at the top click 'Insert' and then click 'Module'. Copy and paste the macro into the empty code window that opens up. Close the code module window to return to your sheet. Insert a button on your sheet and assign the macro to it. Click it and you're done.

 

[excellearner17]

Thank you, apologies if it's a silly question, but can I just leave the button "on" all the time so that whenever the workbook is open or updated it automatically updates my output tab with the latest version of the table?

 

[D3allamerican07]

I agree with mumps. Macros are much more dynamic and the button would allow even the simplest person to use it.

 

[D3allamerican07]

Yes, follow these instructions and then paste in the code below.

• Open the excel workbook
• Press Alt+F11 to open VBA Editor
• Double click on ThisWorkbook from Project Explorer
• Copy the above code and Paste in the code window
• Save the file as macro enabled workbook
• Open the workbook to test it, it will Run a Macro Automatically. You should see a message box as shown above

Sub Workbook_Open()

    rawdataLR = Sheets("Raw Data").Range("A" & Rows.Count).End(xlUp).Row
    outputLR = Sheets("Output").Range("A" & Rows.Count).End(xlUp).Row
    
    'Clear Output sheets so no duplicate values are added
    If outputLR > 1 Then
        Sheets("Output").Range("A2:C" & outputLR).ClearContents
    End If
    
    'Place blank raw data in output sheet
    For Each cell In Sheets("Raw Data").Range("D2:D" & rawdataLR)
        If cell.Value = "" Then
            With Sheets("Output")
                LR = Sheets("Output").Range("A" & Rows.Count).End(xlUp).Row
                
                .Range("A" & LR + 1).Value = Sheets("Raw Data").Range("A" & cell.Row).Value
                .Range("B" & LR + 1).Value = Sheets("Raw Data").Range("B" & cell.Row).Value
                .Range("C" & LR + 1).Value = Sheets("Raw Data").Range("C" & cell.Row).Value
            End With
        End If
    Next cell
    
MsgBox "Updated upon opening complete"
End Sub

 

[mumps]

That can certainly be done. Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the left hand pane, double click on ThisWorkbook. Copy/paste the following macro into the code window that opens up. Close the window to return to your sheet. Save the workbook as a macro-enabled file and then close it. When you re-open the file, it will automatically update the output tab. Keep in mind that the update will only happen when you open the workbook. You could also have the output tab updated when you save the workbook or close the workbook or have all three options to work for you. If you're interested in doing that, please let me know.

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Sheet2").UsedRange.ClearContents
    Sheets("Sheet1").Rows(1).EntireRow.Copy Sheets("Sheet2").Cells(1, 1)
    Sheets("Sheet1").Range("A1:D" & LastRow).AutoFilter Field:=4, Criteria1:="="
    Sheets("Sheet1").Range("A2:D" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1, 0)
    If Sheets("Sheet1").AutoFilterMode = True Then Sheets("Sheet1").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub