Differentiating between clients for a specific recap

[January1991]

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

 

[Trevor G]

Welcome to the forum.

What email system are you using as there is nothing I recognise that is using an email client..

Also could you look to use the code tags on the ribbon which will help determine your code.

 

[January1991]

I am using Microsoft outlook to send our clients their trading recaps, so here is the full code.

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
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

If client <> "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) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

With MailItem
.Subject = sSubject$
.HTMLBody = RangetoHTML(rng) & "<br>" & Signature
.Display
.CC = "rmayhew@rjobrien.com; wlankfer@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 xublishsource=", _
"align=left xublishsource=")

'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

 

[January1991]

I am using Microsoft outlook to send our clients their trading recaps, so here is the full code.

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
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

If client <> "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) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

With MailItem
.Subject = sSubject$
.HTMLBody = RangetoHTML(rng) & "<br>" & Signature
.Display
.CC = "rmayhew@rjobrien.com; wlankfer@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 xublishsource=", _
"align=left xublishsource=")

'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

Global recap builder file x2

 

[Trevor G]

thanks for sharing the code. I can't see where the email addresses are coming from! Nothing in you display of your tables shows an email address.

 

[January1991]

It just populates an email and then I put in the email addresses in manually on outlook

 

[January1991]

Anyone who could please help!