Macro to produce e-mails based on values in cell

[sturnusek]

Hi all,

I have a table that is being filled out with risk orders that I have to e-mail to a customer so they can review it. There can be loads of them, so populating all can take a long time.

It has to be dependant on the region (F Column) and the Sold to (E Column), so if there are two orders in region 'Americas' and sold to is the same, I want it to copy the information about these orders (from column A to column G) and create a new e-mail template, preferably filling the subject as the Region & Sold to and send it to e-mail address in column G assigned to this order.

If there is two orders for Americas, but the Sold to value is different, I want it to populate two e-mails using the logic above, instead of one - preferably creating a loop until all is checked and populated without sending the actual e-mail, just creating a template to just validate the information and then click send.

There is multiple regions in the column, from Americas to Asia,

Does anyone has any ideas how to achieve this? I tried to look, but there has to be few checks and I am completely clueless how to even start writing a macro for this.

Appreciate your help

 

[Logit]

.
Re your updated request. Here are two new macros to replace the existing:

Sub CreateSheets()


    Dim Cell    As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet


    Set RngBeg = Worksheets("Risk").Range("H2")
    Set RngEnd = Worksheets("Risk").Cells(Rows.Count, "H").End(xlUp)


Application.ScreenUpdating = False


        ' Exit if the list is empty.
        If RngEnd.Row < RngBeg.Row Then Exit Sub


        For Each Cell In Worksheets("Risk").Range(RngBeg, RngEnd)
            On Error Resume Next
            
                ' No error means the worksheet exists.
                Set Wks = Worksheets(Cell.Value)


                ' Add a new worksheet and name it.
                If Err <> 0 Then
                    Set Wks = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                    Wks.Name = Cell.Value
                End If
            On Error GoTo 0
            
        Next Cell
        
Application.ScreenUpdating = True


MakeHeaders


End Sub

Sub CopyData()
Application.ScreenUpdating = False
Dim i As Long
Dim LastRow As Long
'On Error GoTo M
LastRow = Sheets("Risk").Cells(Rows.Count, "G").End(xlUp).Row
Dim ans As String
    
    For i = 2 To LastRow
    ans = Sheets("Risk").Cells(i, 8).Value
        Sheets("Risk").Rows(i).Copy Sheets(ans).Rows(Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1)
        Sheets(ans).Range("A1").EntireRow.Font.Bold = True
        Sheets(ans).Columns("A:H").EntireColumn.AutoFit
    Next
Sheets("Risk").Activate
Sheets("Risk").Range("A1").Select
Application.ScreenUpdating = True


SummarizeSheets


'Exit Sub


'M:
'MsgBox "No such sheet as  " & ans & " exist"
Application.ScreenUpdating = True




End Sub

 

[sturnusek]

Thank you so much, you are an absolute star!

 

[Logit]

Glad to help.