Page 2 of 2 FirstFirst 12
Results 11 to 13 of 13

Thread: Macro to produce e-mails based on values in cell

  1. #11
    Board Regular Logit's Avatar
    Join Date
    Aug 2016
    Location
    United States
    Posts
    2,900
    Post Thanks / Like
    Mentioned
    39 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Macro to produce e-mails based on values in cell

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

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


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

  2. #12
    New Member
    Join Date
    Sep 2018
    Posts
    49
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to produce e-mails based on values in cell

    Thank you so much, you are an absolute star!

  3. #13
    Board Regular Logit's Avatar
    Join Date
    Aug 2016
    Location
    United States
    Posts
    2,900
    Post Thanks / Like
    Mentioned
    39 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Macro to produce e-mails based on values in cell

    Glad to help.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •