How to grab values from different columns in a row and write them to a single cell on a separate row-CodePudding

I have an excel sheet with peoples names, age, gender, and health status. Im trying to use vba to automatically group all people in column A who are unhealthy (sick) and healthy (not sick) and write it to a single cell (E9) for example. I am able to iterate through the cells for each person just fine, however the code I came up with overwrites the cell with the last value only. Can someone please assist with the logic so that all the information is displayed correctly?

What current code does:

What I want it to do:

And here is my code:

Sub test()

Dim Names As Range
Dim Age As Range
Dim Health As Range
Dim LastRow As Long

LastRow = Worksheets("Sheet1").Cells(65536, "A").End(xlUp).Row
Set Names = Worksheets("Sheet1").Range("A2:A" & LastRow)

    For Each Name In Names
    
        Set Age = Worksheets("Sheet1").Range("B" & Name.Row)
        Set Health = Worksheets("Sheet1").Range("D" & Name.Row)
        
        If Age.Value = "Young" Or Age.Value = "Old" And Health.Value = "Sick" Then
            Worksheets("Sheet1").Range("E9") = "Unhealthy: " & Name.Value
            
        End If

    If Age.Value = "Young" Or Age.Value = "Old" And Health.Value = "Not Sick" Then
            Worksheets("Sheet1").Range("E9") = "Healthy: " & Name.Value
            
        End If
    
    Next

End Sub

CodePudding user response：

Create two variable to hold the unhealthy and healthy names then do the write to the cell after the loop:

Sub test()

    Dim Names As Range
    Dim Age As Range
    Dim Health As Range
    Dim LastRow As Long
    Dim hlt As String
    Dim unhlt As String
    Dim hdl As String
    Dim uhdl As String
    
    LastRow = Worksheets("Sheet1").Cells(65536, "A").End(xlUp).Row
    Set Names = Worksheets("Sheet1").Range("A2:A" & LastRow)

    For Each Name In Names    
        Set Age = Worksheets("Sheet1").Range("B" & Name.Row)
        Set Health = Worksheets("Sheet1").Range("D" & Name.Row)
        
        If Age.Value = "Young" Or Age.Value = "Old" And Health.Value = "Sick" Then
            unhlt = unhlt & uhdl & Name.Value
            uhdl = ";"            
        End If
        If Age.Value = "Young" Or Age.Value = "Old" And Health.Value = "Not Sick" Then
             hlt = hlt & hdl & Name.Value
             hdl = ";"
        End If    
    Next
    
    Worksheets("Sheet1").Range("E9") = "Unhealthy: " & unhlt & Chr(10) & "Healthy: " & hlt

End Sub