Is there a way to have values displayed if it appear under multiple events?

[Tee51]

Hi,

Are there any formulas for excel that will allow values to be displayed if they are in multiple events. Using the example below, I would like a cell to display "Trucks" because it is under New and Junk.

Example:
Trucks New
Trucks New
Cars Old
SUVs Used
Trucks Junk


Thanks for the help!
Tee

[Pete_UK]

Not sure why you have Trucks New twice, but perhaps you could use conditional formatting with a COUNTIFS formula.

Hope this helps.

Pete

[Leith Ross]

Hello Tee,

Welcome to the Forum!

In your example, are the words all in the same cell or one word in one column? For example is "Trucks New" in cell A1 or in cells A1 and B1?

[Tee51]

Hi Leith,

The words are in different cells
Trucks would be in Column A and New would be in Column B.

Also, I forgot to ask in my original post, is there anyway to have multiple values displayed? In the example below, "Vans" and "Trucks" should be displayed because they appearing in different conditions.

Example:
Trucks New
Vans Junk
Trucks New
Cars Old
SUVs Used
Trucks Junk
Vans Used

Thanks

[Leith Ross]

Hello Tee51,

Again, would the "Trucks" and "Vans" be in one cell, split across the columns, or down rows?

[Tee51]

They would be listed down rows

[Leith Ross]

Hello Tee51,

Okay, you would have a list in a in another column going down the rows, correct?

[Tee51]

That is correct.

[Leith Ross]

Hello Tee51,

I first started out trying to create a formula solution. It become so complicated that I abandoned it for a VBA solution. The attached workbook contains the macro below along with a button on "Sheet1" to activate it.

Macro Code

Sub CreateList()
    
    Dim Data As Variant
    Dim Dict As Object
    Dim Key As String
    Dim MyList() As Variant
    Dim n As Long
    Dim Rng As Range
        
        Set Rng = ActiveSheet.Range("A1").CurrentRegion
        Rng.Columns(3).ClearContents
        Data = Rng.Resize(ColumnSize:=2).Value
    
        Set Dict = CreateObject("Scripting.Dictionary")
        
            For i = 1 To UBound(Data, 1)
                Key = Trim(Data(i, 1))
                If Key <> "" Then
                    If Not Dict.Exists(Key) Then
                        Dict.Add Key, Data(i, 2)
                    End If
                    If Dict(Key) <> Data(i, 2) Then
                        ReDim Preserve MyList(n)
                        MyList(n) = Key
                        n = n + 1
                    End If
                End If
            Next i
            
        If Dict.Count > 0 Then
            Range("C1").Resize(UBound(MyList, 1) + 1).Value = Application.Transpose(MyList)
        End If
            
End Sub

[Tee51]

Thanks Leith,

It works great. If I decided to run the VBA from worksheet 2 while using data from worksheet 1, how would I correct the ranges and such?

[Leith Ross]

Hello Tee51,

If you can provide the ranges involved, I can change the macro accordingly. The other option would be to post the workbook and I can make the changes directly.

[Tee51]

Hello Tee51,

If you can provide the ranges involved, I can change the macro accordingly. The other option would be to post the workbook and I can make the changes directly.

Good Afternoon Leith,
I was up all night trying to alter your code. I came very close ! See sheet 3, the only issue is I cannot figure how to get the A range on sheet3 to clear instead of C range on sheet1.

[Leith Ross]

Hello Tee51,

This is a little confusing. The original macro uses the data in column "A" to determine if there are multiple events based on column "B". If you clear "A" there will be no data to check.

[Tee51]

Hello Tee51,

This is a little confusing. The original macro uses the data in column "A" to determine if there are multiple events based on column "B". If you clear "A" there will be no data to check.

Clear A in sheet3, which only lists the return values. I want to keep A in sheet1, as you said if you clear that there will be no data.

In your code contents in column 3 (the column which the return values are listed) are cleared each time the marco runs. I would like that to happen in the other worksheet "sheet3"

[Leith Ross]

Hello Tee51,

So, you want to clear column "C" on "Sheet3" when the macro runs?

[Tee51]

No, column A, well range A2 since I have a heading in A1 on Sheet3.

[Leith Ross]

Hello Tee51,

Try this out on "Sheet3".

Sub CommandButton1_Click()
    
    Dim Data As Variant
    Dim Dict As Object
    Dim Key As String
    Dim MyList() As Variant
    Dim n As Long
    Dim Rng As Range
    Dim Wks As Worksheet
        
        Set Wks = ActiveSheet
        
        Set Rng = Worksheets("Sheet1").Range("A1").CurrentRegion
        Rng.ClearContents
        
        Data = Rng.Resize(ColumnSize:=2).Value
    
        Set Dict = CreateObject("Scripting.Dictionary")
        
            For i = 1 To UBound(Data, 1)
                Key = Trim(Data(i, 1))
                If Key <> "" Then
                    If Not Dict.Exists(Key) Then
                        Dict.Add Key, Data(i, 2)
                    End If
                    If Dict(Key) <> Data(i, 2) Then
                        ReDim Preserve MyList(n)
                        MyList(n) = Key
                        n = n + 1
                    End If
                End If
            Next i
            
        If Dict.Count > 0 Then
            Wks.Range("A2").Resize(UBound(MyList, 1) + 1).Value = Application.Transpose(MyList)
        End If
            
End Sub

[Tee51]

Hello Tee51,

Try this out on "Sheet3".

Sub CommandButton1_Click()
    
    Dim Data As Variant
    Dim Dict As Object
    Dim Key As String
    Dim MyList() As Variant
    Dim n As Long
    Dim Rng As Range
    Dim Wks As Worksheet
        
        Set Wks = ActiveSheet
        
        Set Rng = Worksheets("Sheet1").Range("A1").CurrentRegion
        Rng.ClearContents
        
        Data = Rng.Resize(ColumnSize:=2).Value
    
        Set Dict = CreateObject("Scripting.Dictionary")
        
            For i = 1 To UBound(Data, 1)
                Key = Trim(Data(i, 1))
                If Key <> "" Then
                    If Not Dict.Exists(Key) Then
                        Dict.Add Key, Data(i, 2)
                    End If
                    If Dict(Key) <> Data(i, 2) Then
                        ReDim Preserve MyList(n)
                        MyList(n) = Key
                        n = n + 1
                    End If
                End If
            Next i
            
        If Dict.Count > 0 Then
            Wks.Range("A2").Resize(UBound(MyList, 1) + 1).Value = Application.Transpose(MyList)
        End If
            
End Sub

This part of the code cleared sheet1 entirely.

Rng.ClearContents

I changed it to read

Wks.Columns(1).ClearContents

Now it clears the content in column A on sheet3 including the heading. So how do I get it to clear everything in column A excluding the heading?

[Leith Ross]

Hello Tee51,

This should work correctly.

Sub CommandButton1_Click()
    
    Dim Data As Variant
    Dim Dict As Object
    Dim Key As String
    Dim MyList() As Variant
    Dim n As Long
    Dim Rng As Range
    Dim RngEnd As Range
    Dim Wks As Worksheet
        
        Set Wks = ActiveSheet
        
        Set Rng = Worksheets("Sheet1").Range("A2")
        Set RngEnd = Rng.Parent.Cells(Rows.Count, Rng.Column).End(xlUp)
        If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Rng.Parent.Range(Rng, RngEnd)
        
        Rng.ClearContents
        
        Data = Rng.Resize(ColumnSize:=2).Value
    
        Set Dict = CreateObject("Scripting.Dictionary")
        
            For i = 1 To UBound(Data, 1)
                Key = Trim(Data(i, 1))
                If Key <> "" Then
                    If Not Dict.Exists(Key) Then
                        Dict.Add Key, Data(i, 2)
                    End If
                    If Dict(Key) <> Data(i, 2) Then
                        ReDim Preserve MyList(n)
                        MyList(n) = Key
                        n = n + 1
                    End If
                End If
            Next i
            
        If Dict.Count > 0 Then
            Wks.Range("A2").Resize(UBound(MyList, 1) + 1).Value = Application.Transpose(MyList)
        End If
            
End Sub

[Tee51]

Getting closer. It's still clearing sheet1 column A (but it left the heading which is what I wanted) instead of sheet3

[BigDawg15]

Tee51,

Try changing

Set Rng = Worksheets("Sheet1").Range("A2")

to

Set Rng = Worksheets("Sheet3").Range("A2")

.

That should do it.

BigDawg15

[Tee51]

Tee51,

Try changing

Set Rng = Worksheets("Sheet1").Range("A2")

to

Set Rng = Worksheets("Sheet3").Range("A2")

.

That should do it.

BigDawg15

No luck, cleared out sheet3 Column A.