Vba list items separated by comma when conditions met

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,798
Office Version
  1. 2016
Platform
  1. Windows
I have a table that I have names in column A then inside column G are numbers.

Column A is in range A17:A25 then G is also G17:G25.

So in cell A16, I want to get all names that have values greater than 10 in column G.

These names should be separated by comma. And if only one exists then no comma.

Also if none exists, we blank A16.

I am stacked .

I need help.

Thanks
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

NewOrderFac33

Well-known Member
Joined
Sep 26, 2011
Messages
1,252
Hi, Kelly,
How's this:
Code:
Sub Plus10Names()
    
    Dim MyString As String
    Dim MyCell As Range
    Dim MyCount As Long
    
    MyString = ""
    MyCount = 0
    
    For Each MyCell In Sheets("Sheet1").Range("A17:A25")
        If MyCell.Offset(0, 6) > 10 Then
            If Len(MyString) = 0 Then
                MyString = MyCell.Formula
            Else
                MyString = MyString & "," & MyCell.Formula
            End If
            MyCount = MyCount + 1
        End If
    Next
    
    If MyCount > 0 Then
        Sheets("Sheet1").Range("A16").Formula = MyString
    Else
        Sheets("Sheet1").Range("A16").ClearContents
    End If
    
End Sub
Regards
Pete
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,450
Office Version
  1. 2013
Platform
  1. Windows
Code:
Sub names()
Dim c As Range, nm As String
With ActiveSheet
    .Range("A16").ClearContents
    For Each c In .Range("A17:A25")
        If c.Offset(, 6).Value > 10 Then
            If nm = "" Then
                nm = c.Value
            Else
                nm = nm & ", " & c.Value
            End If
        End If
    Next
    .Range("A16") = nm
End With
End Sub
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,798
Office Version
  1. 2016
Platform
  1. Windows
Very sweet.


Both codes are cute.

I am running series of tests to select the fastest and smoother. :)

Thanks again
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,798
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT



I modified your code like this then I got stacked again. Can you pull me out again?

Code:
Sub names()
Dim c As Range, nm As String, nm1 As String, OutPut As String 
With ActiveSheet
    .Range("A16").ClearContents
    For Each c In .Range("A17:A25")
        

Select Case c.Offset(, 6).Value 
        Case Is >10
            If nm = "" Then
                nm = c.Value
            Else
                nm = nm & ", " & c.Value
            End If

            Case Is <5
                         If nm1 = "" Then
                nm1 = c.Value
            Else
                nm1 = nm1 & ", " & c.Value
            End If
        End Select 
    Next
    'This is where I am stacked at:
     'OutPut =
End With
End Sub

I want the out to be a message box that will work like this :
1. If both nm and nm1 are blank say none
2. If only nm blank say low
3. If only nm1 blank say high
4. If both not blank say both

:)

I need tech support
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,798
Office Version
  1. 2016
Platform
  1. Windows
How do I put "and" between the last two instead of comma?
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,450
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Code:
Sub names()
Dim c As Range, nm As String, nm1 As String, OutPut As String
With ActiveSheet
    .Range("A16").ClearContents
    For Each c In .Range("A17:A25")
        Select Case c.Offset(, 6).Value
            Case Is > 10
                If nm = "" Then
                    nm = c.Value
                Else
                    nm = nm & ", " & c.Value
                End If
            Case Is < 5
                If nm1 = "" Then
                    nm1 = c.Value
                Else
                    nm1 = nm1 & ", " & c.Value
                End If
        End Select
    Next
    Range("A16") = Left(nm, InStrRev(nm, ",") - 1) & " and " & Mid(nm, InStrRev(nm, ",") + 1)
    If nm = "" And nm1 = "" Then
        MsgBox "None"
    ElseIf nm = "" And nm1 <> "" Then
        MsgBox "Low"
    ElseIf nm <> "" And nm1 = "" Then
        MsgBox "High"
    ElseIf nm <> "" And nm1 <> "" Then
    MsgBox "Both"
    End If
End With
End Sub
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,798
Office Version
  1. 2016
Platform
  1. Windows
Cool cool. I knew you can pull me me out again.

I am very grateful
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Also try the following

Code:
Sub List_Names()
    For Each v In Range("A17:A25")
        If v.Offset(0, 6).Value > 10 Then cad1 = cad1 & v.Value & ", "
        If v.Offset(0, 6).Value < 5 Then cad2 = cad2 & v.Value & ", "
    Next
    On Error Resume Next
    cad1 = Left(cad1, Len(cad1) - 2)
    cad2 = Left(cad2, Len(cad2) - 2)
    cad1 = WorksheetFunction.Replace(cad1, InStrRev(cad1, ","), 1, " y")
    cad2 = WorksheetFunction.Replace(cad2, InStrRev(cad2, ","), 1, " y")
    Range("A16").Value = cad1
    
    If cad1 = "" And cad2 = "" Then wmes = "None"
    If cad1 = "" And cad2 <> "" Then wmes = "low"
    If cad1 <> "" And cad2 = "" Then wmes = "high"
    If cad1 <> "" And cad2 <> "" Then wmes = "both"
    MsgBox wmes
End Sub
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,798
Office Version
  1. 2016
Platform
  1. Windows
Also try the following

Code:
Sub List_Names()
    For Each v In Range("A17:A25")
        If v.Offset(0, 6).Value > 10 Then cad1 = cad1 & v.Value & ", "
        If v.Offset(0, 6).Value < 5 Then cad2 = cad2 & v.Value & ", "
    Next
    On Error Resume Next
    cad1 = Left(cad1, Len(cad1) - 2)
    cad2 = Left(cad2, Len(cad2) - 2)
    cad1 = WorksheetFunction.Replace(cad1, InStrRev(cad1, ","), 1, " y")
    cad2 = WorksheetFunction.Replace(cad2, InStrRev(cad2, ","), 1, " y")
    Range("A16").Value = cad1
    
    If cad1 = "" And cad2 = "" Then wmes = "None"
    If cad1 = "" And cad2 <> "" Then wmes = "low"
    If cad1 <> "" And cad2 = "" Then wmes = "high"
    If cad1 <> "" And cad2 <> "" Then wmes = "both"
    MsgBox wmes
End Sub

Great ! ! !

I can't wait to get smarter tooo :LOL:
 

Watch MrExcel Video

Forum statistics

Threads
1,109,522
Messages
5,529,328
Members
409,863
Latest member
stacy09
Top