I've spent the last couple few weeks to try to figure this out why below goven is not working, I've managed to stop all the errors, however the email doesn't show up in my inbox . I've tried to change everything up and still it doesn't show up. The main purpose is to send the data with his or her data only to an gmail,
Sub send_email_via_Gmail()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim myMail As CDO.Message
Set myMail = New CDO.Message
Dim i As Integer
Dim j As Integer
Dim last_row As Integer
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smptauthenticate") = 1
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 1465
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "shiva.nand#kaercher.com"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "123456"
last_row = Application.WorksheetFunction.CountA(sh.Range("X:X"))
For i = 2 To last_row
myMail.To = sh.Range("Y" & i).Value
myMail.CC = sh.Range("Z" & i).Value & " ; " & sh.Range("AA" & i).Value & " ; " & sh.Range("AB" & i).Value
myMail.Subject = "Order Dispatch Details"
myMail.htmlbody = "<html><body><br>Dear Concern, Please find below dispatch status<br><br><style>table, th, td { border: 1px solid black; border-collapse: collapse;}</style>" & _
"<table><tr><td><b>" & sh.Range("A1").Value & "</b></td><td><b>" & sh.Range("B1").Value & "</b></td><td><b>" & sh.Range("C1").Value & "</b></td><td><b>" & sh.Range("D1").Value & "</b></td><td><b>" & sh.Range("E1").Value & "</b></td><td><b>" & sh.Range("F1").Value & "</b></td><td><b>" & sh.Range("G1").Value & "</b></td><td><b>" & sh.Range("H1").Value & "</b></td><td><b>" & sh.Range("I1").Value & "</b></td><td><b>" & sh.Range("J1").Value & "</b></td><td><b>" & sh.Range("K1").Value & "</b></td><td><b>" & sh.Range("L1").Value & "</b></td><td><b>" & sh.Range("M1").Value & "</b></td><td><b>" & sh.Range("N1").Value & "</b></td><td><b>" & sh.Range("O1").Value & "</b></td><td><b>" & sh.Range("P1").Value & "</b></td><td><b>" & sh.Range("Q1").Value & "</b></td><td><b>" & sh.Range("R1").Value & "</b></td><td><b>" & sh.Range("S1").Value & "</b></td><td><b>" & sh.Range("T1").Value & "</b></td><td><b>" & sh.Range("U1").Value & "</b></td><td><b>" & sh.Range("V1").Value & _
"</b></td><td><b>" & sh.Range("W1").Value & "</b></td><td><b>" & sh.Range("X1").Value & _
"<tr><td>" & sh.Range("A" & i).Value & "</td><td>" & sh.Range("B" & i).Value & "</td><td>" & sh.Range("C" & i).Value & "</td><td>" & sh.Range("D" & i).Value & "</td><td>" & sh.Range("E" & i).Value & "</td><td>" & sh.Range("F" & i).Value & "</td><td>" & sh.Range("G" & i).Value & "</td><td>" & sh.Range("H" & i).Value & "</td><td>" & sh.Range("I" & i).Value & "</td><td>" & sh.Range("J" & i).Value & "</td><td>" & sh.Range("K" & i).Value & "</td><td>" & sh.Range("L" & i).Value & "</td><td>" & sh.Range("M" & i).Value & "</td><td>" & sh.Range("N" & i).Value & "</td><td>" & sh.Range("O" & i).Value & "</td><td>" & sh.Range("P" & i).Value & "</td><td>" & sh.Range("Q" & i).Value & "</td><td>" & sh.Range("R" & i).Value & "</td><td>" & sh.Range("S" & i).Value & "</td><td>" & sh.Range("T" & i).Value & "</td><td>" & sh.Range("U" & i).Value & "</td><td>" & sh.Range("V" & i).Value & "</td><td>" & sh.Range("W" & i).Value & "</td><td>" & sh.Range("X" & i).Value & "</td><td>"
For j = (i + 1) To last_row
If sh.Range("Y" & i).Value = sh.Range("Y" & j).Value Then
myMail.htmlbody = myMail.htmlbody & "<tr><td>" & sh.Range("A" & j).Value & "</td><td>" & sh.Range("B" & j).Value & "</td><td>" & sh.Range("C" & j).Value & "</td><td>" & sh.Range("D" & j).Value & "</td><td>" & sh.Range("E" & j).Value & "</td><td>" & sh.Range("F" & j).Value & "</td><td>" & sh.Range("G" & j).Value & "</td><td>" & sh.Range("H" & j).Value & "</td><td>" & sh.Range("I" & j).Value & "</td><td>" & sh.Range("J" & j).Value & "</td><td>" & sh.Range("K" & j).Value & "</td><td>" & sh.Range("L" & j).Value & "</td><td>" & sh.Range("M" & j).Value & "</td><td>" & sh.Range("N" & j).Value & "</td><td>" & sh.Range("O" & j).Value & "</td><td>" & sh.Range("P" & j).Value & "</td><td>" & sh.Range("Q" & j).Value & "</td><td>" & sh.Range("R" & j).Value & "</td><td>" & sh.Range("S" & j).Value & "</td><td>" & sh.Range("T" & j).Value & "</td><td>" & sh.Range("U" & j).Value & "</td><td>" & sh.Range("V" & j).Value & "</td><td>" & sh.Range("W" & j).Value & "</td><td>" & sh.Range("X" & j).Value & "</td><td>"
i = j
End If
Next j
myMail.htmlbody = myMail.htmlbody & "</table></body><br>Regards,<br>Vikas Karn,<br> Mobile no: +91-83 7795 2790</html>"
myMail.Send
Next i
MsgBox "Sent"
Set myMail = Nothing
End Sub
Related
I am trying to make a macro that loops through a table on any sheet across a document and generated emails with info from that table to the individuals on each line. I think I got most of it to work but I can't figure out why .Body is no longer sending any information to outlook.
When I had shorter test messages it worked but now it isn't sending any body text to Outlook. My .To line is working fine as is my subject.
With OutMail
.To = Range("D" & i).Value
.CC = ""
.BCC = ""
.Subject = ActiveSheet.Name & " Service Insert"
'.HTMLBody = "Hi " & Range(C, i).Value & "<br><br>" & "Please see your Service Insert Below." & "<br>" & "<br>" _
& Range(S, 1).Value & "<br>" & "Services Played: " & Range(S, i).Value & "<br>" & "Doubling Services: " & Range("T" & i).Value & "<br>" & "Move Up Services: " & Range("W" & i).Value & " services from " & Range(Y, i) & "<br>" & "Solo Services: " & Range(Z, i).Value & "<br><br>" _
& Range(AA, 1).Value & "<br>" & "Services Played: " & Range(AA, i).Value & "<br>" & "Doubling Services: " & Range(AB, i).Value & "<br>" & "Move Up Services: " & Range(AE, i).Value & " services from " & Range(AG, i) & "<br>" & "Solo Services: " & Range(AH, i).Value & "<br><br>" _
& "Pay Period Totals" & "<br>" & "Total Leave Used: " & Range(F, i).Value & "<br>" & "Sick Leave Used: " & Range(i, i).Value & "<br>" & "Total Doubling Pay: " & Range(K, i).Value & "<br>" & "Total Move Up Pay: " & Range(L, i).Value & "<br>" & "Total Solo Pay: " & Range(M, i).Value & "<br>" & "Total Pay Correction: " & Range(N, i).Value & "<br>" & "Parking Reimbursement: " & Range(O, i).Value & "<br>" & "Mileage Reimbursement: " & Range(P, i).Value & "<br>" & "Travel Reimbursement: " & Range(Q, i).Value & "<br>" & "Total Additional Pay: " & Range(R, i).Value & "<br><br>" _
& "Season Totals" & "<br><br>" & "Total Season Services Used: " & Range(AZ, i).Value & "<br>" & "Sick Leave Remaining: " & Range(AY, i).Value & "<br><br>" & "Please let me know if you have any questions or concerns." & "<br><br>" & "Best, "
.Body = "Hi " & Range("C" & i).Value & vbNewLine & vbNewLine & "Please see your Service Insert Below." & vbNewLine & vbNewLine _
& Range("S1").Value & vbNewLine & "Services Played: " & Range("S" & i).Value & vbNewLine & "Doubling Services: " & Range("T" & i).Value & vbNewLine & "Move Up Services: " & Range("W" & i).Value & " services from " & Range("Y" & i) & vbNewLine & "Solo Services: " & Range("Z" & i).Value & vbNewLine & vbNewLine _
& Range("AA1").Value & vbNewLine & "Services Played: " & Range("AA" & i).Value & vbNewLine & "Doubling Services: " & Range("AB" & i).Value & vbNewLine & "Move Up Services: " & Range("AE" & i).Value & " services from " & Range("AG" & i) & vbNewLine & "Solo Services: " & Range("AH" & i).Value & vbNewLine & vbNewLine _
& "Pay Period Totals" & vbNewLine & "Total Leave Used: " & Range("F" & i).Value & vbNewLine & "Sick Leave Used: " & Range("I" & i).Value & vbNewLine & "Total Doubling Pay: " & Range("K" And i).Value & vbNewLine & "Total Move Up Pay: " & Range("L" And i).Value & vbNewLine & "Total Solo Pay: " & Range("M" And i).Value & vbNewLine & "Total Pay Correction: " & Range("N" And i).Value & vbNewLine & "Parking Reimbursement: " & Range("O" And i).Value & vbNewLine & "Mileage Reimbursement: " & Range("P" And i).Value & vbNewLine & "Travel Reimbursement: " & Range("Q" And i).Value & vbNewLine & "Total Additional Pay: " & Range("R" And i).Value & vbNewLine & vbNewLine _
& "Season Totals" & vbNewLine & vbNewLine & "Total Season Services Used: " & Range("AZ" & i).Value & vbNewLine & "Sick Leave Remaining: " & Range("AY" & i).Value & vbNewLine & vbNewLine & "Please let me know if you have any questions or concerns." & vbNewLine & vbNewLine & "Best, "
'.Attachments.Add ActiveWorkbook.FullName
.Display 'or use .Send
End With
On Error GoTo 0
This is the Body and HTMLBody I tried to make work, neither is sending any information, even failed cell searches to outlook.
I can show more of my the code if needed, for readability I hope this is enough.
Create a variable to create your body string by making some concatenations then assign the string to .Body. This way you can easily check your string and find an error by running step by step.
Dim emailBody as string: emailBody = ""
emailBody = emailBody & "Hi " & Range("C" & i).Value & vbNewLine & vbNewLine
emailBody = emailBody & "Please see your Service Insert Below." & vbNewLine & vbNewLine
emailBody = emailBody & Range("S1").Value & vbNewLine
...
With OutMail
...
.Body = emailBody
...
End With
Hi I am newbies about vba. I want to compare and count the cell number that continuously lowers the previous cell however the code just successfully counts 1-2 days and n/a only.
Thanks
data set
Sub Mars()
Dim i As Integer
Sheets("working").Select
For i = 2 To 111
If Range("U" & i).Value > Range("T" & i).Value Then
Range("W" & i).Value = "n/a"
ElseIf Range("U" & i).Value < Range("T" & i).Value Then
Range("W" & i).Value = "1"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value Then
Range("W" & i).Value = "2"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value Then
Range("W" & i).Value = "3"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value Then
Range("W" & i).Value = "4"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value Then
Range("W" & i).Value = "5"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value Then
Range("W" & i).Value = "6"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value Then
Range("W" & i).Value = "7"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) Then
Range("W" & i).Value = "8"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value Then
Range("W" & i).Value = "9"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value < Range("K" & i).Value Then
Range("W" & i).Value = "10"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value < Range("K" & i).Value < Range("J" & i).Value Then
Range("W" & i).Value = "11"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value < Range("K" & i).Value < Range("J" & i).Value < Range("I" & i).Value Then
Range("W" & i).Value = "12"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value < Range("K" & i).Value < Range("J" & i).Value < Range("I" & i).Value < Range("H" & i).Value Then
Range("W" & i).Value = "13"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value < Range("K" & i).Value < Range("J" & i).Value < Range("I" & i).Value < Range("H" & i).Value < Range("G" & i).Value Then
Range("W" & i).Value = "14"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value < Range("K" & i).Value < Range("J" & i).Value < Range("I" & i).Value < Range("H" & i).Value < Range("G" & i).Value < Range("F" & i).Value Then
Range("W" & i).Value = "15"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value < Range("K" & i).Value < Range("J" & i).Value < Range("I" & i).Value < Range("H" & i).Value < Range("G" & i).Value < Range("F" & i).Value < Range("E" & i).Value Then
Range("W" & i).Value = "16"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value < Range("K" & i).Value < Range("J" & i).Value < Range("I" & i).Value < Range("H" & i).Value < Range("G" & i).Value < Range("F" & i).Value < Range("E" & i).Value < Range("D" & i).Value Then
Range("W" & i).Value = "17"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value < Range("K" & i).Value < Range("J" & i).Value < Range("I" & i).Value < Range("H" & i).Value < Range("G" & i).Value < Range("F" & i).Value < Range("E" & i).Value < Range("D" & i).Value < Range("C" & i).Value Then
Range("W" & i).Value = "18"
ElseIf Range("U" & i).Value < Range("T" & i).Value < Range("S" & i).Value < Range("R" & i).Value < Range("Q" & i).Value < Range("P" & i).Value < Range("O" & i).Value < Range("N" & i).Value < Range("M" & i) < Range("L" & i).Value < Range("K" & i).Value < Range("J" & i).Value < Range("I" & i).Value < Range("H" & i).Value < Range("G" & i).Value < Range("F" & i).Value < Range("E" & i).Value < Range("D" & i).Value < Range("C" & i).Value < Range("B" & i).Value Then
Range("W" & i).Value = "19"
End If
Next I
End Sub
In your code, the're a lot of this construction:
IF A < B < C < ...
This is not correct, it should be:
IF (A < B) AND (B < C) AND (C < ...) ...
For readability reasons, I would advise you the following formatting:
IF (A < B) AND_
(B < C) AND_
(C < ...) ...
(The underscore means that the "source code line" is not finished and continues on the next line.)
I have written multiple scripts in VBA for multiple Buttons in an excel sheet to automate a process for the same. All I want is for someone to review my code and critic its cleanliness. It would be very helpful to have suggestions on how to make the code cleaner and optimize the process.
Private Sub CommandButton1_Click()
Dim last_row As Double
Call ModelwithEach
last_row = Range("F" & Rows.Count).End(xlUp).Row
Range("AM1").Value = "WithEach"
Range("AM3:AM" & last_row).Formula = "=F3&R3"
Range("L3:L" & last_row).Formula = "=VLOOKUP(AM3,'[Indemed Datafeed Latest.xlsm]Sheet1'!$A:$B,2,0)"
Range("M3:M" & last_row).Formula = "=VLOOKUP(AM3,'[Indemed Datafeed Latest.xlsm]Sheet1'!$A:$K,11,0)"
Range("N3:N" & last_row).Formula = "=VLOOKUP(AM3,'[Indemed Datafeed Latest.xlsm]Sheet1'!$A:$H,8,0)"
Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Clear
End Sub
Private Sub CommandButton2_Click()
Dim last_row As Double
last_row = Range("U" & Rows.Count).End(xlUp).Row
Range("V3:V" & last_row).Formula = "=VLOOKUP(U3,'[current pricing sheet july 2019 - Copy.xlsx]Sheet1'!$A:$B,2,0)"
Range("W3:W" & last_row).Formula = "=VLOOKUP(U3,'[current pricing sheet july 2019 - Copy.xlsx]Sheet1'!$A:$B,2,0)"
Dim Shipping As Double
Dim i As Double
Shipping = Range("W" & Rows.Count).End(xlUp).Row
For i = 3 To Shipping
If Range("W" & i).Value >= 70 Then
Range("X" & i).Value = "Free Shipping"
Range("Y" & i).Value = 0
Range("Z" & i).Value = "Yes"
ElseIf Range("W" & i).Value <= 69.99 Then
Range("X" & i).Value = "Really Flat"
Range("Y" & i).Value = 6.99
Range("Z" & i).Value = "No"
Else
End If
Next i
End Sub
Private Sub CommandButton3_Click()
Dim last_row As Double
Dim i As Double
last_row = Range("F" & Rows.Count).End(xlUp).Row
For i = 3 To last_row
If Range("N" & i).Value > Range("K" & i).Value Then
Range("G" & i).Value = "McKesson"
ElseIf Range("K" & i).Value > Range("N" & i).Value Then
Range("G" & i).Value = "Independence Medical"
End If
Next i
Range("XFD2:XFD" & last_row).Formula = "=UPPER(LEFT(Q2,2))"
Range("S3:S" & last_row).Formula = "=PROPER(VLOOKUP(F3,'MediUSA wound Care Feed.csv'!$A:$G,7,0))"
For i = 2 To last_row
Range("T" & i).Value = Range("R" & i) & "/" & Range("S" & i)
Next i
'If Range("M2:M" & last_row).Value = "Case" Then
' Range("B2:B" & last_row).Formula = "=UPPER(LEFT(Q2,2))&F2"
' Range("B2:B" & last_row).Value = Range("B" & i).Value & "-CS"
'ElseIf Range("M" & i) = "Box" Then
' Range("B2:B" & last_row).Formula = "=UPPER(LEFT(Q2,2))&F2"
' Range("B" & i).Value = Range("B" & i).Value & "-BX"
' End If
' Next i
For i = 2 To last_row
If Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Case" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-CS"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Each" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & ""
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Box" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-BX"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Pair" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-PR"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Package" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-PK"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Carton" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-CT"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Dozen" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-DZ"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Vial" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-VL"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Roll" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-RL"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Tray" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-TR"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Can" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-CN"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Jar" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-JR"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Bag" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-BG"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Gallon" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-GL"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Set" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-ST"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Kit" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-KT"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Gross" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-GR"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Pad" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-PD"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Tube" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-TU"
ElseIf Range("F" & i).Value = Range("F" & i).Value And Range("S" & i) = "Sleeve" Then
Range("B" & i).Value = Range("XFD" & i) & Range("F" & i) & "-SL"
Else
Range("B" & i).Value = ""
End If
Next i
End Sub
Private Sub CommandButton4_Click()
Dim last_row As Double
Dim i As Double
last_row = Range("F" & Rows.Count).End(xlUp).Row
For i = 2 To last_row
If InStr(1, UCase(Range("B" & i)), "-MI") <> 0 Then
Range("F" & i).Value = Range("F" & i + 1)
Range("G" & i).Value = Range("G" & i + 1)
Range("U" & i).Value = Range("U" & i + 1)
Range("V" & i).Value = Range("V" & i + 1)
Range("W" & i).Value = Range("W" & i + 1)
Range("X" & i).Value = Range("X" & i + 1)
Range("Y" & i).Value = Range("Y" & i + 1)
Range("Z" & i).Value = Range("Z" & i + 1)
Range("D" & i).Value = "Parent Matrix Item"
Range("A" & i & ":AL" & i).Interior.Color = vbYellow
Range("A" & i - 1 & ":AL" & i - 1).Value = Range("A1:AL1").Value
Range("A" & i - 1 & ":AL" & i - 1).Interior.Color = vbGreen
Range("AE" & i).Value = "<p>Warranty and stuff</p>"
Range("AF" & i).Value = "<p>Return Policy</p>"
Range("AA" & i).Value = Range("C" & i) & "|" & Range("F" & i)
Range("Q" & i).Value = Range("Q" & i + 1)
Range("E" & i + 1 & ":E" & last_row).Value = Range("A" & i)
Range("E" & i).Value = " "
Else
Range("D" & i).Value = "Child Matrix Item"
End If
Next i
Range("AG2:AG" & last_row).Formula = "Supply Item"
End Sub
Private Sub CommandButton5_Click()
Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Clear
End Sub
Private Sub CommandButton6_Click()
Dim last_row As Double
last_row = Range("F" & Rows.Count).End(xlUp).Row
Range("H3:H" & last_row).Formula = "=VLOOKUP(AM3,'[Mck Merge Sheet.xlsx]Sheet1'!$A:$D,4,0)"
Range("J3:J" & last_row).Formula = "=VLOOKUP(AM3,'[Mck Merge Sheet.xlsx]Sheet1'!$A:$H,8,0)"
Range("K3:K" & last_row).Formula = "=VLOOKUP(AM3,'[Mck Merge Sheet.xlsx]Sheet1'!$A:$J,10,0)"
Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Clear
End Sub
Any word of advice will be much appreciated and thanked for.
My final goal is to print my cells pipe delimited so in order to do so I am trying to print everything on each row into cell AB on each row. I am trying to loop through each row to do so however I am currently getting the top row of code repeated in all my rows instead of each row individually being printed.
Sub print_misc()
Dim cell As Range
Dim lastRow As Long
Sheets("1099-Misc_Form_Template").Select
lastRow = Range("B" & Rows.Count).End(xlUp).row
For Each cell In Range("AB2:" & "AB" & lastRow)
cell.Value = Range("B2") & "|" & Range("C2") & "|" & Range("D2") & "|" & Range("E2") & "|" & Range("F2") & "|" & Range("G2") & "|" & Range("H2") & "|" & Range("I2") & "|" & Range("J2") & "|" & Range("L2") & "|" & Range("M2") & "|" & Range("N2") & "|" & Range("O2") & "|" & Range("P2") & "|" & Range("Q2") & "|" & Range("R2") & "|" & Range("S2") & "|" & Range("U2") & "|" & Range("V2") & "|" & Range("W2") & "|" & Range("X2") & "|" & Range("Y2") & "|" & Range("Z2") & "|" & Range("AA2")
Next
End Sub
Each cell in AB shows the result of the combined cells in that row (pipe delimited).
Current output:
Expected output:
You aren't incrementing the value of the row for each iteration of cell. You are point at row 2 for each one.
You also shouldn't use Select it is unnecessary just directly reference the sheet object.
Sub print_misc()
Dim cell As Range
Dim lastRow As Long
dim iter as long
with Sheets("1099-Misc_Form_Template")
lastRow = .Range("B" & Rows.Count).End(xlUp).row
iter = 2
For Each cell In .Range("AB2:" & "AB" & lastRow)
cell.Value = .Range("B" & iter) & "|" & .Range("C" & iter) & "|" & _
.Range("D" & iter) & "|" & .Range("E" & iter) & "|" & _
.Range("F" & iter) & "|" & .Range("G" & iter) & "|" & _
.Range("H" & iter) & "|" & .Range("I" & iter) & "|" & _
.Range("J" & iter) & "|" & .Range("L" & iter) & "|" & _
.Range("M" & iter) & "|" & .Range("N" & iter) & "|" & _
.Range("O" & iter) & "|" & .Range("P" & iter) & "|" & _
.Range("Q" & iter) & "|" & .Range("R" & iter) & "|" & _
.Range("S" & iter) & "|" & .Range("U" & iter) & "|" & _
.Range("V" & iter) & "|" & .Range("W" & iter) & "|" & _
.Range("X" & iter) & "|" & .Range("Y" & iter) & "|" & _
.Range("Z" & iter) & "|" & .Range("AA" & iter)
iter = iter + 1
Next
end with
End Sub
I have in "Sheet1" numerous email addresses, in columns K, M, O, Q, S, U, W, Y, AA.
I want to create an email that will be sent to all the addresses taken from the last row in Sheet1. Same for data in email body taken from last row.
Dim MonOutlook As Object
Dim MonMessage As Object
Dim EmailTo As String
With Worksheets("Sheet1")
EmailTo = .Range("K" & ligne) & ";" & .Range("M" & ligne) & ";" & .Range("O" & ligne) & ";" & .Range("Q" & ligne) & ";" & .Range("S" & ligne) & ";" & .Range("U" & ligne) & ";" & .Range("W" & ligne) & ";" & .Range("Y" & ligne) & ";" & .Range("AA" & ligne)
End With
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
MonMessage.To = ""
MonMessage.Cc = ""
MonMessage.Bcc = EmailTo
MonMessage.Subject = "Rate request" & " " & "for" & " " & ThisWorkbook.Sheets("Sheet1").Range("B" & ligne)
MonMessage.body = "Hello,"
Chr (13) & Chr(13) & "Please send me rate for" & " " & ThisWorkbook.Sheets("Sheet1").Range("G" & ligne) & " " & "rooms on basis" & " " & ThisWorkbook.Sheets("Sheet1").Range("H" & ligne) & _
Chr(13) & Chr(13) & "in hotel:" & " " & ThisWorkbook.Sheets("Sheet1").Range("J" & ligne) & _
Chr(13) & Chr(13) & "for the period" & " " & ThisWorkbook.Sheets("suivi").Range("C" & ligne) & " " & ThisWorkbook.Sheets("Sheet1").Range("D" & ligne) & _
Chr(13) & Chr(13) & "Thank you!" & _
Chr(13) & Chr(13) & Application.UserName & " " & "-" & " " & "x Tours"
MonMessage.Display
With ThisWorkbook.Sheets("Sheet1").Range("AB" & ligne)
.Value = Date
.NumberFormat = "dd/mm/yyyy"
End With
ActiveWorkbook.Save
Try the code below, explanations inside the code's comments.
Option Explicit
Sub EmailContactsLastRow()
Dim MonOutlook As Object
Dim MonMessage As Object
Dim EmailSht As Worksheet
Dim EmailTo As String
Dim ligne As Long
' set the worksheet object
Set EmailSht = ThisWorkbook.Sheets("Sheet1")
With EmailSht
ligne = .Cells(.Rows.Count, "K").End(xlUp).Row ' get last row with data in column K
EmailTo = .Range("K" & ligne) & ";" & .Range("M" & ligne) & ";" & .Range("O" & ligne) & ";" & _
.Range("Q" & ligne) & ";" & .Range("S" & ligne) & ";" & .Range("U" & ligne) & ";" & _
.Range("W" & ligne) & ";" & .Range("Y" & ligne) & ";" & .Range("AA" & ligne)
End With
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
With MonMessage
.To = ""
.Cc = ""
.Bcc = EmailTo
.Subject = "Rate request" & " " & "for" & " " & EmailSht.Range("B" & ligne)
.body = "Hello,"
Chr (13) & Chr(13) & "Please send me rate for" & " " & EmailSht.Range("G" & ligne) & " " & "rooms on basis" & " " & EmailSht.Range("H" & ligne) & _
Chr(13) & Chr(13) & "in hotel:" & " " & EmailSht.Range("J" & ligne) & _
Chr(13) & Chr(13) & "for the period" & " " & EmailSht.Range("C" & ligne) & " " & EmailSht.Range("D" & ligne) & _
Chr(13) & Chr(13) & "Thank you!" & _
Chr(13) & Chr(13) & Application.UserName & " " & "-" & " " & "x Tours"
.Display ' <-- this displays the email. not sending it
.send ' <-- this sends the email out
End With
With EmailSht.Range("AB" & ligne)
.Value = Date
.NumberFormat = "dd/mm/yyyy"
End With
ThisWorkbook.Save
End Sub