Hi all,
I have sheet1 where there is data table.
Sheet2 is intended to be storing actioned data
In sheet1 module I have following code which works fine and does following:
As soon as comments are typed in column 'N'
- It changes respective row colour to RED ( Cond Form)
-In column 'P' it counts the contents in column 'N' ( Counta formula)
- It then populates application username in column 'Q'
-It populates current date & time in column 'R'
When command button is pressed it dose the following:
- copied data from respective row and displays it in outlook
This allows to send email with appropriate data.
all works fine.
I want to achieve the following:
After email is sent, I want respective row to be deleted and pasted as value in sheet2 in next row free.
( I am getting issues here and not been able to do it correctly) Need help here.
Code is
Please help. I have attached trial sheet
Kind regards:)
I have sheet1 where there is data table.
Sheet2 is intended to be storing actioned data
In sheet1 module I have following code which works fine and does following:
As soon as comments are typed in column 'N'
- It changes respective row colour to RED ( Cond Form)
-In column 'P' it counts the contents in column 'N' ( Counta formula)
- It then populates application username in column 'Q'
-It populates current date & time in column 'R'
When command button is pressed it dose the following:
- copied data from respective row and displays it in outlook
This allows to send email with appropriate data.
all works fine.
I want to achieve the following:
After email is sent, I want respective row to be deleted and pasted as value in sheet2 in next row free.
( I am getting issues here and not been able to do it correctly) Need help here.
Code is
Code:
Sub Button1_Click()
Dim ce As Range, i As Long
Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String
For i = 2 To Sheets("sheet1").Range("N65536").End(xlUp).Row
If Cells(i, 16).Value > 0 Then
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With Sheets("sheet1")
strto = "Me@somewhere.com"
strcc = ""
strbcc = ""
strsub = "Subject-" & .Cells(i, 7).Value
strbody = "Hi" & vbNewLine & _
" Date : " & .Cells(i, 1).Value & vbNewLine & _
" LC : " & .Cells(i, 2).Value & vbNewLine & _
" AST : " & .Cells(i, 3).Value & vbNewLine & _
" ASTI : " & .Cells(i, 4).Value & vbNewLine & _
" FIB : " & .Cells(i, 5).Value & vbNewLine & _
" FD : " & .Cells(i, 6).Value & vbNewLine & _
" FMX : " & .Cells(i, 7).Value & vbNewLine & _
"PT : " & .Cells(i, 8).Value & vbNewLine & _
"Due date : " & .Cells(i, 11).Value & vbNewLine & _
"WHY : " & .Cells(i, 14).Value & vbNewLine & _
"Please update : " & vbNewLine & _
"From Us" & vbNewLine & _
vbCrLf & "Thank you" & vbNewLine & _
vbCrLf & .Cells(i, 17).Value
End With
With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
.display
End With
Cells(i, 18).Value = Now()
Set OutMail = Nothing
Set OutApp = Nothing
'here I want to add that respective row is deleted and pasted to sheet2 in next row free
End If
Next i
End SubKind regards:)
