trying to create vba to copy data when option button is selected

Hello, on the attached worksheet I am looking for VBA to copy and paste to the body of an email - column A thru I, and any rows used, when the option button is clicked. A user would then input the email address to send. We are using outlook.
Then when the transfer to complete option is selected, transfer the data starting in A3 to I3 to the complete tab and auto saving for history. Then clearing all data starting in row 3 on the 1^st tab making the worksheet ready for the next user. Also the date and time listed in I1 like the example shown on the complete tab. Thank you in advance for all help.




also posted at - http://www.ozgrid.com/forum/showthread.php?t=204550

I was able to get the create email option working with this code:

Code:

---

Option Explicit


Public Const olMailItem = 0


Public Sub Create_Outlook_Email()


    Dim lastRow As Long
    Dim tempSheet As Worksheet
    Dim r As Long, c As Long
    Dim HTML As String
    Dim OutApp As Object 'Outlook.Application
    Dim OutEmail As Object 'Outlook.MailItem
   
    With ActiveSheet
       
        'Filter active sheet on columns A:I where column A is not blank
       
        Application.ScreenUpdating = False
        .AutoFilterMode = False
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        .Range("A1:I" & lastRow).AutoFilter Field:=1, Criteria1:="<>"
       
        'Add a temporary sheet and copy filtered rows to it
       
        Set tempSheet = ThisWorkbook.Worksheets.Add
        .AutoFilter.Range.Copy tempSheet.Range("A1")
        .AutoFilterMode = False
        Application.ScreenUpdating = True
       
    End With
   
    'Loop through rows and columns A:I on temporary sheet and construct HTML table
   
    HTML = ""
    HTML = HTML & "<br>"
    HTML = HTML & "<table border='1' cellspacing='0' cellpadding='5' style='font-family:arial; font-size:10'>" & vbCrLf
    HTML = HTML & "<tbody>" & vbCrLf
   
    With tempSheet
        'Row 1 - column headings
        HTML = HTML & "<tr style='background-color:#0000FF; color:#FFFFFF'>"
        For c = 1 To 9
            HTML = HTML & "<td>" & .Cells(1, c).Value & "</td>"
        Next
        HTML = HTML & "</tr>" & vbCrLf
       
        'Rows 2 to end - data rows
        For r = 2 To .UsedRange.Rows.Count
            HTML = HTML & "<tr>"
            For c = 1 To 9
                HTML = HTML & "<td>" & .Cells(r, c).Value & "</td>"
            Next
            HTML = HTML & "</tr>" & vbCrLf
        Next
    End With
   
    HTML = HTML & "</tbody>" & vbCrLf
    HTML = HTML & "</table>" & vbCrLf
    HTML = HTML & "<br>"
   
    'Delete the temporary sheet
   
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    tempSheet.Delete
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   
    Set OutApp = CreateObject("Outlook.Application") 'New Outlook.Application
    Set OutEmail = OutApp.CreateItem(olMailItem)
       
    'Create email with the HTML table and display the email


    With OutEmail
        '.To = "email.address1@email.com"
        '.CC = "email.address2@email.com"
        '.Subject = "Email subject"
        .HTMLBody = HTML
        .Display
    End With
         
    Set OutEmail = Nothing
    Set OutApp = Nothing
       
End Sub

---

now just looking for the transfer when complete option.

.

Code:

---

Option Explicit


 
Public Const olMailItem = 0
 
 
Public Sub Create_Outlook_Email()
   
   
    Dim lastRow As Long
    Dim tempSheet As Worksheet
    Dim r As Long, c As Long
    Dim HTML As String
    Dim OutApp As Object 'Outlook.Application
    Dim OutEmail As Object 'Outlook.MailItem
   
    With ActiveSheet
       
        'Filter active sheet on columns A:I where column A is not blank
       
        Application.ScreenUpdating = False
        .AutoFilterMode = False
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        .Range("A1:I" & lastRow).AutoFilter Field:=1, Criteria1:="<>"
       
        'Add a temporary sheet and copy filtered rows to it
       
        Set tempSheet = ThisWorkbook.Worksheets.Add
        .AutoFilter.Range.Copy tempSheet.Range("A1")
        .AutoFilterMode = False
        Application.ScreenUpdating = True
       
    End With
   
    'Loop through rows and columns A:I on temporary sheet and construct HTML table
   
    HTML = ""
    HTML = HTML & "<br>"
    HTML = HTML & "<table border='1' cellspacing='0' cellpadding='5' style='font-family:arial; font-size:10'>" & vbCrLf
    HTML = HTML & "<tbody>" & vbCrLf
   
    With tempSheet
        'Row 1 - column headings
        HTML = HTML & "<tr style='background-color:#0000FF; color:#FFFFFF'>"
        For c = 1 To 9
            HTML = HTML & "<td>" & .Cells(1, c).Value & "</td>"
        Next
        HTML = HTML & "</tr>" & vbCrLf
       
        'Rows 2 to end - data rows
        For r = 2 To .UsedRange.Rows.Count
            HTML = HTML & "<tr>"
            For c = 1 To 9
                HTML = HTML & "<td>" & .Cells(r, c).Value & "</td>"
            Next
            HTML = HTML & "</tr>" & vbCrLf
        Next
    End With
   
    HTML = HTML & "</tbody>" & vbCrLf
    HTML = HTML & "</table>" & vbCrLf
    HTML = HTML & "<br>"
   
    'Delete the temporary sheet
   
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    tempSheet.Delete
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   
    Set OutApp = CreateObject("Outlook.Application") 'New Outlook.Application
    Set OutEmail = OutApp.CreateItem(olMailItem)
   
    'Create email with the HTML table and display the email
   
   
    With OutEmail
        '.To = "email.address1@email.com"
        '.CC = "email.address2@email.com"
        '.Subject = "Email subject"
        .HTMLBody = HTML
        .Display
    End With
   
    Set OutEmail = Nothing
    Set OutApp = Nothing
   
End Sub


Sub cpyToComplete()


    Sheets("Complete").Range("A2:I6").Value = Sheets("FXF CALL IN LOG").Range("A3:I7").Value
    Sheets("Complete").Range("J1").Value = Sheets("FXF CALL IN LOG").Range("I1").Value
   
    Sheets("FXF CALL IN LOG").Range("A3:I7").Value = ""


End Sub

---

Thank you logit. I will not have a chance to check it out until Monday morning as I have left my office for the weekend. I will test it then and let you know. I appreciate your time. And the code.

.
You are welcome.

Quote:

---

Originally Posted by Logit

.
You are welcome.

---

Good Morning Logit, This transfers to log as needed. Forgot to mention that this will be used as the history for the data as it is transferred over. The new data would need to go to the next line down, and auto save each time new data is transferred.

.
Try this change to the copy macro :

Code:

---

Sub cpyToComplete()
   
Application.ScreenUpdating = False
Dim CopySheet As Worksheet
Dim PasteSheet As Worksheet


Set CopySheet = Worksheets("FXF CALL IN LOG")
Set PasteSheet = Worksheets("Complete")


PasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Value = Sheets("FXF CALL IN LOG").Range("J1").Value
CopySheet.Range("A2:I7").Copy
PasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues


Application.CutCopyMode = False
Application.ScreenUpdating = True


End Sub

---

Hello, and thanks for the quick update. I sure it is my lack of knowledge in VBA, but I cant get it to do anything now. Here is the updated file.

.
Something was corrupted in the workbook. Here is the fixed copy.

That did it Logit, Thanks very much, I really appreciate your time, and code.

You are welcome.