VBA Excel send all info in only one email if one value is same

I want send a email with VBA where I send user number to email address but if he have 2 user number he send the 2 user number in the same mail.

My code with my excel : Excel

Private Sub CommandButton1_Click()

    Dim mail As Variant
    Dim ligne As Integer

    Set mail = CreateObject("Outlook.Application") 'create an outlook object

    For ligne = 1 To 5

        If Range("n" & ligne) = "OK" Then

            With mail.CreateItem(olMailItem) ' informs the program that we want to send a mail.
                .Subject = TEST
                .To = Range("q" & ligne)
                .CC = "[email protected]"
                .Body = "Hi number " & Range("I" & ligne) & " You are owner of users :" 'users
                .SendUsingAccount = "[email protected]"
                .Display 'display the mail before sending it if not place send to send
            End With
            
        End If
        
    Next ligne
    
End Sub

Solution

Please, test the next updated code. It uses a dictionary to extract the unique mail accounts and all the necessary data to behave as you need. The code has a Stop line, after .Display to let you see how the new mail looks in its window. Do what is written in the respective line comment. Otherwise, it will create so many new mail window as many UNIQUE records are in Q:Q:

Sub sendMailCond()
 Dim sh As Worksheet, lastRQ As Long, arr, arrUs, i As Long
 Dim mail As Object, strUsers As String, dict As Object
 
 Set sh = ActiveSheet
 lastRQ = sh.Range("Q" & sh.rows.count).End(xlUp).row 'last row on Q:Q
 arr = sh.Range("A2:Q" & lastRQ).Value 'place the range in an array for faster processing
 
 'Place the necessary data in the dictionary:
 Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary
 For i = 1 To UBound(arr)
    If arr(i, 14) Like "OK" Then
         If Not dict.exists(arr(i, 17)) Then
                dict.Add arr(i, 17), arr(i, 9) & "|" & arr(i, 1)
         Else
               dict(arr(i, 17)) = dict(arr(i, 17)) & "::" & arr(i, 1)
         End If
         
    End If
 Next i
 
 Set mail = CreateObject("Outlook.Application") 'create an outlook object
 'extract the necessary data:
 For i = 0 To dict.count - 1
     arr = Split(dict.Items()(i), "|") 'split the item by "|" to extract value from I:I and a concatenation by "::" separator if more then one key exists
     arrUs = Split(arr(1), "::")

       If UBound(arrUs) > 0 Then
              strUsers = Join(arrUs, " / ")
       Else
              strUsers = arr(1)
       End If
      With mail.CreateItem(olMailItem) ' informs the program that we want to send a mail.
            .Subject = "Test"
            .To = dict.Keys()(i)
            .cc = "[email protected]"
            .body = "Hi number " & arr(0) & " You are owner of users : " & strUsers
            .SendUsingAccount = "[email protected]"
            .Display: Stop 'See the New mail in Outlook and check its contents
                           'press F5 to continue!
     End With
 Next i
End Sub

If it returns as you want, you can replace the line starting with Disply with .Send.

Edited:

The new version extracting from M:M, too and placing at the end of body:

Sub sendMailCond2()
 Dim sh As Worksheet, lastRQ As Long, arr, arrUs, i As Long
 Dim mail As Object, strUsers As String, dict As Object
 
 Set sh = ActiveSheet
 lastRQ = sh.Range("Q" & sh.rows.count).End(xlUp).row
 arr = sh.Range("A2:Q" & lastRQ).Value
 
 'Place the necessary data in the dictionary:
 Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary
 For i = 1 To UBound(arr)
    If arr(i, 14) Like "OK" Then
         If Not dict.exists(arr(i, 17)) Then
                dict.Add arr(i, 17), arr(i, 9) & "|" & arr(i, 13) & "|" & arr(i, 1)
         Else
                dict(arr(i, 17)) = dict(arr(i, 17)) & "::" & arr(i, 1)
         End If
         
    End If
 Next i
 
 Set mail = CreateObject("Outlook.Application") 'create an outlook object
 'extract the necessary data:
 For i = 0 To dict.count - 1
     arr = Split(dict.Items()(i), "|")
     arrUs = Split(arr(2), "::")

       If UBound(arrUs) > 0 Then
              strUsers = Join(arrUs, " / ") & ". Your last connection was " & arr(1)
       Else
              strUsers = arr(2) & ". Your last connection was " & arr(1)
       End If
      With mail.CreateItem(olMailItem) ' informs the program that we want to send a mail.
            .Subject = "Test"
            .To = dict.Keys()(i)
            .cc = "[email protected]"
            .body = "Hi number " & arr(0) & " You are owner of users : " & strUsers
            .SendUsingAccount = "[email protected]"
            .Display: Stop 'See the New mail in Outlook and check its contents
                           'press F5 to continue!
     End With
 Next i
End Sub