VBA Code - Trying to differentiate client from client

Anonymous

Hi,

I am trying to send out trade recaps to our clients, but we have many different clients, but when I run the macro it groups all clients together and adds them to one email. I would like to be able to differentiate between clients.

As you can see there are multiple different accounts, but all client accounts start with AGR PH9, I would like to split them up into individual client emails for example AGR PH9AGA and PH9AVOT or AGR PH9TRVPG.

Here is the code I had originally that worked until we changed the account names in our internal systems so that all client accounts start with AGR PH9....

'Construct individual recap per client
Do
Bool_Option = False
Worksheets("Recap").Select
Range("A1:M1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Worksheets("Original Data").Select
Range("A1:M1").Select
Selection.Copy
Worksheets("Recap").Select
Range("A1:M1").Select
ActiveSheet.Paste

Worksheets("Original Data").Select
Range("J2").Select
If Range("J3").Value = "" Then
Else: Selection.End(xlDown).Select
End If

' If IsError(Left(Right(Selection.Text, Len(Selection.Text) - WorksheetFunction.Find(" ", Selection)), WorksheetFunction.Find(" ", Selection) - 1)) Then
' client = Selection.Text
' Else:
client = Left(Right(Selection.Text, Len(Selection.Text) - WorksheetFunction.Find(" ", Selection)), WorksheetFunction.Find(" ", Selection) - 1)
' End If

Do
NbClientOrders = NbClientOrders + 1
Selection.Offset(-1, 0).Select
If Selection.Text = "Account" Then
Exit Do
End If
' If IsError(Left(Right(Selection.Text, Len(Selection.Text) - WorksheetFunction.Find(" ", Selection)), WorksheetFunction.Find(" ", Selection) - 1)) = True Then
' client2 = Selection.Text
' Else:
client2 = Left(Right(Selection.Text, Len(Selection.Text) - WorksheetFunction.Find(" ", Selection)), WorksheetFunction.Find(" ", Selection) - 1)
' End If
Loop Until client2 <> client

Range("A1").Select
Selection.Offset(NumberOfTrades - NbClientOrders + 1, 0).Select
Range(Selection, Selection.Offset(NbClientOrders - 1, 12)).Select

Set rng = Selection

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

14 answers

Andreas Killer 144.1K Reputation points Volunteer Moderator

2024-11-08T14:27:54+00:00

Add the line

SendMail "TRADE RECAP DTD", ThisAccount.EntireRow

after the line

Case vbOK

Andreas.
Was this answer helpful?

0 comments No comments

Anonymous

Andreas, please see full code below if this helps.

Sub CopyData()

Dim LastRow As Long

Dim wkb As Workbook

Dim File As String

Dim Subject As String

Dim rng As Range

Dim client As String

Dim client2 As String

Dim NbClientOrders As Integer

Dim NumberOfTrades As Integer

Dim Bool_Option As Boolean

Set rng = Nothing

client = ""

client2 = ""

NbClientOrders = 0

NumberOfTrades = 0

'Copy / Paste original confo

Worksheets("Original Data").Select

Range("A2:M2").Select 

Range(Selection, Selection.End(xlDown)).Select 

Selection.ClearContents

Set wkb = Workbooks.Open(Filename:="C:\Users\smayhew\OneDrive - R.J. O'Brien & Associates LLC\Documents\Trade Recaps\Global\TeoExtract.csv")

Workbooks("TeoExtract.csv").Activate

Range("A2:M2").Select

If Range("A3").Value = "" Then 

Else: Range(Selection, Selection.End(xlDown)).Select 

End If

NumberOfTrades = Selection.Rows.Count

Selection.Copy

Windows("Global_RecapBuilder.xlsm").Activate

Worksheets("Original Data").Select

Range("A2").Select

ActiveSheet.Paste

Application.CutCopyMode = False

Workbooks("TeoExtract.csv").Close

'Construct individual recap per client

Bool\_Option = False 

Worksheets("Recap").Select 

Range("A1:M1").Select 

Range(Selection, Selection.End(xlDown)).Select 

Selection.ClearContents 

Worksheets("Original Data").Select 

Range("A1:M1").Select 

Selection.Copy 

Worksheets("Recap").Select 

Range("A1:M1").Select 

ActiveSheet.Paste 

Worksheets("Original Data").Select 

Range("J2").Select 

If Range("J3").Value = "" Then 

Else: Selection.End(xlDown).Select 

End If

' If IsError(Left(Right(Selection.Text, Len(Selection.Text) - WorksheetFunction.Find(" ", Selection)), WorksheetFunction.Find(" ", Selection) - 1)) Then

' client = Selection.Text

' Else:

client = Left(Right(Selection.Text, Len(Selection.Text) - WorksheetFunction.Find(" ", Selection)), WorksheetFunction.Find(" ", Selection) - 1)

' End If

Do 

    NbClientOrders = NbClientOrders + 1 

    Selection.Offset(-1, 0).Select 

    If Selection.Text = "Account" Then 

        Exit Do 

    End If 

  '  If IsError(Left(Right(Selection.Text, Len(Selection.Text) - WorksheetFunction.Find(" ", Selection)), WorksheetFunction.Find(" ", Selection) - 1)) = True Then 

  '      client2 = Selection.Text 

   ' Else: 

client = Left(Right(Selection.Text, Len(Selection.Text) - WorksheetFunction.Find(" ", Selection)), WorksheetFunction.Find(" ", Selection) - 1) 

   ' End If 

Loop Until client2 &lt;&gt; client 

 Range("A1").Select 

Selection.Offset(NumberOfTrades - NbClientOrders + 1, 0).Select 

Range(Selection, Selection.Offset(NbClientOrders - 1, 12)).Select 

Set rng = Selection 

If client &lt;&gt; "GRAINCORP" Then 

    rng.Copy 

    Sheets("Recap").Select 

    Range("A2").Select 

    ActiveSheet.Paste 

    Range("A1:M1").Select 

    Range(Selection, Selection.End(xlDown)).Select 

        With Selection 

            .HorizontalAlignment = xlCenter 

            .VerticalAlignment = xlBottom 

            .WrapText = False 

            .Orientation = 0 

            .AddIndent = True 

            .IndentLevel = 1 

            .ShrinkToFit = False 

            .ReadingOrder = xlContext 

            .MergeCells = False 

        End With 

        Selection.Borders(xlDiagonalDown).LineStyle = xlNone 

        Selection.Borders(xlDiagonalUp).LineStyle = xlNone 

        With Selection.Borders(xlEdgeLeft) 

            .LineStyle = xlContinuous 

            .ColorIndex = 0 

            .TintAndShade = 0 

            .Weight = xlThin 

        End With 

        With Selection.Borders(xlEdgeTop) 

            .LineStyle = xlContinuous 

            .ColorIndex = 0 

            .TintAndShade = 0 

            .Weight = xlThin 

        End With 

        With Selection.Borders(xlEdgeBottom) 

            .LineStyle = xlContinuous 

            .ColorIndex = 0 

            .TintAndShade = 0 

            .Weight = xlThin 

        End With 

        With Selection.Borders(xlEdgeRight) 

            .LineStyle = xlContinuous 

            .ColorIndex = 0 

            .TintAndShade = 0 

            .Weight = xlThin 

        End With 

        With Selection.Borders(xlInsideVertical) 

            .LineStyle = xlContinuous 

            .ColorIndex = 0 

            .TintAndShade = 0 

            .Weight = xlThin 

        End With 

        With Selection.Borders(xlInsideHorizontal) 

            .LineStyle = xlContinuous 

            .ColorIndex = 0 

            .TintAndShade = 0 

            .Weight = xlThin 

        End With 

        Columns("A:M").Select 

        Columns("A:M").EntireColumn.AutoFit 

        Range("A1").Select 

        Range(Selection, Selection.End(xlToRight)).Select 

        Selection.Font.Bold = True 

        Range(Selection, Selection.End(xlDown)).Select 

        With Selection 

            .HorizontalAlignment = xlCenter 

            .VerticalAlignment = xlCenter 

            .WrapText = False 

            .Orientation = 0 

            .AddIndent = True 

            .IndentLevel = 0 

            .ShrinkToFit = False 

            .ReadingOrder = xlContext 

            .MergeCells = False 

        End With 

        Columns("M:M").Delete 

        Columns("K:K").Delete 

        Range("H2").Select 

        For i = 1 To NumberOfTrades 

            If WorksheetFunction.IsNumber(Selection.Value) Then 

                Bool\_Option = True 

            End If 

            i = i + 1 

            Selection.Offset(1, 0).Select 

        Next 

        If Bool\_Option = False Then 

            Columns("H:H").Delete 

            Columns("D:E").Delete 

        Else 

             Columns("D:D").Delete 

        End If 

        Range("A1").Select 

        Range(Selection, Selection.End(xlToRight)).Select 

        Range(Selection, Selection.End(xlDown)).Select 

        rng.Delete 

        NumberOfTrades = NumberOfTrades - NbClientOrders 

        NbClientOrders = 0 

        Set rng = Selection 

Else 

        rng.Delete 

        NumberOfTrades = NumberOfTrades - NbClientOrders 

        NbClientOrders = 0 

End If 

Subject = "TRADE RECAP DTD" 

Call SendMail(Subject, rng)

Loop Until NumberOfTrades = 0

End Sub

Sub SendMail(sSubject$, rng As Range)

Dim AppOutlook As Object 

Dim MailItem As Object 

Dim sBody As String 

Dim olByValue As Object 

Dim SigString As String 

Dim Signature As String 

Set AppOutlook = CreateObject("Outlook.Application") 

Set MailItem = AppOutlook.CreateItem(0) 

sSubject = sSubject & " " & Format(Now(), "dd.mm.yy") 

SigString = Environ("appdata") & \_ 

            "\Microsoft\Signatures\Recap.htm" 

If Dir(SigString) &lt;&gt; "" Then 

    Signature = GetBoiler(SigString) 

Else 

    Signature = "" 

End If 

With MailItem 

    .Subject = sSubject$ 

    .HTMLBody = RangetoHTML(rng) & "&lt;br&gt;" & Signature 

    .Display 

    .CC = "******@rjobrien.com; ******@rjobrien.com" 

End With

' MailItem.send

' Set AppOutlook = Nothing

' Set MailItem = Nothing

End Sub

Function RangetoHTML(rng As Range)

' By Ron de Bruin.

Dim fso As Object 

Dim ts As Object 

Dim TempFile As String 

Dim TempWB As Workbook 

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 

'Copy the range and create a new workbook to past the data in 

rng.Copy 

Set TempWB = Workbooks.Add(1) 

With TempWB.Sheets(1) 

    .Cells(1).PasteSpecial Paste:=8 

    .Cells(1).PasteSpecial xlPasteValues, , False, False 

    .Cells(1).PasteSpecial xlPasteFormats, , False, False 

    .Cells(1).Select 

    Application.CutCopyMode = False 

    On Error Resume Next 

    .DrawingObjects.Visible = True 

    .DrawingObjects.Delete 

    On Error GoTo 0 

End With 

' Add this line 

Application.ReferenceStyle = xlA1 

'Publish the sheet to a htm file 

With TempWB.PublishObjects.Add( \_ 

     SourceType:=xlSourceRange, \_ 

     Filename:=TempFile, \_ 

     Sheet:=TempWB.Sheets(1).Name, \_ 

     Source:=TempWB.Sheets(1).UsedRange.Address, \_ 

     HtmlType:=xlHtmlStatic) 

    .Publish (True) 

End With 

'Read all data from the htm file into RangetoHTML 

Set fso = CreateObject("Scripting.FileSystemObject") 

Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) 

RangetoHTML = ts.readall 

ts.Close 

RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", \_ 

                      "align=left x:publishsource=") 

'Close TempWB 

TempWB.Close savechanges:=False 

'Delete the htm file we used in this function 

Kill TempFile 

Set ts = Nothing 

Set fso = Nothing 

Set TempWB = Nothing

End Function

Function GetBoiler(ByVal sFile As String) As String

Dim fso As Object 

Dim ts As Object 

Set fso = CreateObject("Scripting.FileSystemObject") 

Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2) 

GetBoiler = ts.readall 

ts.Close

End Function

0 comments

Andreas Killer 144.1K Reputation points Volunteer Moderator

2024-11-08T13:36:51+00:00

Stephen,

I can't say exactly, because you mentioned at the beginning that the same clients are grouped together in one email.

The part of the code you posted doesn't include this.

If you look at my code, there is a comment where you can copy the selected rows resp. pass ThisAccount.EntireRow to your mail routine.

Andreas.
Was this answer helpful?

0 comments No comments
Anonymous

2024-11-08T10:51:54+00:00

Thanks Andreas, where would I place this code, do I get rid of the whole code I had and replace it with the one you suggest?
Was this answer helpful?

0 comments No comments
Andreas Killer 144.1K Reputation points Volunteer Moderator

2024-11-07T16:29:47+00:00

Sub Test()
Dim LastAccount As Range, Account As Range, ThisAccount As Range
Dim Answer As VbMsgBoxResult

'For each used cell in column J
For Each Account In Range("J2", Range("J" & Rows.Count).End(xlUp).Offset(1))
'Do we have a previous row?
If LastAccount Is Nothing Then
'No, remember this row
Set LastAccount = Account
Else
'Changed?
If Account <> LastAccount Then
'Refer to all cells
Set ThisAccount = Range(LastAccount, Account.Offset(-1))
'Select the entire rows
ThisAccount.EntireRow.Select
'Ask
Answer = MsgBox("This are the rows for " & LastAccount & ". Continue?", vbOKCancel)
Select Case Answer
Case vbOK
'Mail this rows... however you do it
Case vbCancel
Exit Sub
End Select
'Next account start here
Set LastAccount = Account
End If
End If
Next
End Sub
Was this answer helpful?

0 comments No comments

Share via

VBA Code - Trying to differentiate client from client

14 answers