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
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 coded a form for entering product information that works and would like to clean it up. Currently for every product division, I have copied and pasted the same code to take the values from the form and apply them to the correct division sheet. I would like to have the code occur once, and then reference it in the code for the 22 divisions. I have not been able to find a solution to this, likely because I do not know the proper terminology.
Here is a section of what I would like to fix:
Case "DIVISION 21 - FIRE SUPPRESSION"
Set ws = Sheets("Div-21")
LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value
Case "DIVISION 22 - PLUMBING"
Set ws = Sheets("Div-22")
LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value
Case "DIVISION 23 - HEATING VENTILATING AND AIR CONDITIONING"
Set ws = Sheets("Div-23")
LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value
Case "DIVISION 26 - ELECTRICAL"
Set ws = Sheets("Div-26")
LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value
Case "DIVISION 27 - COMMUNICATIONS"
Set ws = Sheets("Div-27")
LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value
Here is what I would like to do if possible:
[Refrence Code]=
LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value
Case "DIVISION 21 - FIRE SUPPRESSION"
Set ws = Sheets("Div-21")
[Refrence code]
Case "DIVISION 22 - PLUMBING"
Set ws = Sheets("Div-22")
[Refrence code]
Case "DIVISION 23 - HEATING VENTILATING AND AIR CONDITIONING"
Set ws = Sheets("Div-23")
[Refrence code]
Case "DIVISION 26 - ELECTRICAL"
Set ws = Sheets("Div-26")
[Refrence code]
Case "DIVISION 27 - COMMUNICATIONS"
Set ws = Sheets("Div-27")
[Refrence code]
Any help would be appreciated. If possible, please explain in a clear and detailed way since I am still very much a novice at VBA coding and a beginner at coding in general.
The part that changes is ws. Keep the Select Case and move the repetitive block afterwards.
Case "DIVISION 21 - FIRE SUPPRESSION"
Set ws = Sheets("Div-21")
Case "DIVISION 22 - PLUMBING"
Set ws = Sheets("Div-22")
Case "DIVISION 22 - PLUMBING"
Set ws = Sheets("Div-23")
...
Case Else
' handle other cases, perhaps `Exit Sub`
End Select
' Now you need only one instance of the repetitive block
' You've got the right `ws` from above.
LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
... and so on
If you are dealing with a repetitive DIVISION - ## - .... pattern, then you could refactor your Select Case into a separate function that parses the sheet name instead of listing all the possibilities as you currently do.
Looking to not repeat code is great thing. In this case you can simply just do the following:
Case "DIVISION 21 - FIRE SUPPRESSION"
Set ws = Sheets("Div-21")
Case "DIVISION 22 - PLUMBING"
Set ws = Sheets("Div-22")
End Select
LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value
But as you are learning about how to "trim down code", I wanted to cover also calling a sub with arguments, like so.
Sub SheetSelect()
Dim ws as worksheet
Case "DIVISION 21 - FIRE SUPPRESSION"
Set ws = Sheets("Div-21")
Call DoStuff(ws)
Case "DIVISION 22 - PLUMBING"
Set ws = Sheets("Div-22")
Call DoStuff(ws)
End Select
End Sub
Sub DoStuff(ws As WorkSheet)
LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
ws.Range("b" & LastRow).Value = Specs_Number
ws.Range("c" & LastRow).Value = Specs_Name
ws.Range("d" & LastRow).Value = Me.TextBoxProduct_Generic_Name.Value
ws.Range("e" & LastRow).Value = Me.TextBoxProduct_Manufacturer.Value
ws.Range("s" & LastRow).Value = Me.TextBoxAuthor_Initials.Value
ws.Range("f" & LastRow).Value = Me.TextBoxModel_Name.Value
ws.Range("k" & LastRow).Value = Me.TextBoxProduct_Serial_Number.Value
ws.Range("g" & LastRow).Value = Me.TextBox_Website_Link.Value
AddLink ws.Range("i" & LastRow), Me.TextBoxPicture_File_Link.Value
ws.Range("j" & LastRow).Value = Me.TextBoxColor.Value
ws.Range("r" & LastRow).Value = Me.TextBoxLocal_Locations.Value
ws.Range("l" & LastRow).Value = Me.TextBoxFeatures.Value
ws.Range("h" & LastRow).Value = Me.TextBoxComments.Value
ws.Range("m" & LastRow).Value = Me.TextBoxSales_Rep_Name.Value
ws.Range("n" & LastRow).Value = Me.TextBoxSales_Rep_Phone.Value
ws.Range("o" & LastRow).Value = Me.TextBoxSales_Rep_Email.Value
End Sub
I don't know what it accepted practice/best policy, but I often put separate subs in separate modules so that I don't have modules that are super long. I also have a "main" module which only calls each sub that does something. This allows me to comment out subs for debugging and re-introduce them one by one.
Eg:
Sub Main_Sub()
Call First_Task
'Call Second_Task ' Comment out "Second Task" for debugging till "First_Task" works as expected, this also allows for future debugging.
End Sub
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
Thanks to this site I adapted a code for my own needs , this macro allows me to compare specific cells of an X rows with another cells of Y row and there is a match between all cells not only 1 or 2 cells but all cells of that row then it give 1 and 0 if no match is found
the problem that the macro is comparing row X with Y which what I want but i doesn't compare X with Y+1 or Y+2 , it passes directly to X+1 and compare it with Y+1
to better understand my problem see below :
in this image two line with yellow color are identical and in column AO there is 1 infront of the first line and 1 infront of the second line
so what is to compare every row with the other rows(X with Y,Y+1,Y+2) and passe on to the next Row and when there is match that is highlighted or returns 1 in column "AO"
Code :
Sub check()
Dim check1, check2 As Variant
Dim l As Long
Dim ElementsSame As Boolean
For i = 2 To 74
check1 = Array(Range("F" & i), Range("G" & i), Range("H" & i), Range("I"
& i), Range("J" & i), Range("K" & i), Range("L" & i), Range("M" & i),
Range("N" & i), Range("O" & i), Range("P" & i), Range("Q" & i),
Range("R" & i), Range("S" & i), Range("T" & i), Range("U" & i),
Range("V" & i), Range("W" & i), Range("X" & i), Range("Y" & i),
Range("Z" & i), Range("AA" & i), Range("AB" & i), Range("AC" & i),
Range("AD" & i), Range("AE" & i), Range("AF" & i), Range("AG" & i),
Range("AH" & i), Range("AI" & i), Range("AJ" & i), Range("AL" & i),
Range("AM" & i))
For D = 3 To 74
check2 = Array(Range("F" & D), Range("G" & D), Range("H" & D), Range("I"
& D), Range("J" & D), Range("K" & D), Range("L" & D), Range("M" & D),
Range("N" & D), Range("O" & D), Range("P" & D), Range("Q" & D),
Range("R" & D), Range("S" & D), Range("T" & D), Range("U" & D),
Range("V" & D), Range("W" & D), Range("X" & D), Range("Y" & D),
Range("Z" & D), Range("AA" & D), Range("AB" & D), Range("AC" & D),
Range("AD" & D), Range("AE" & D), Range("AF" & D), Range("AG" & D),
Range("AH" & D), Range("AI" & D), Range("AJ" & D), Range("AL" & D),
Range("AM" & D))
ElementsSame = True
For l = 0 To 32
If check1(l) <> check2(l) Then
ElementsSame = False
Exit For
End If
Next l
If ElementsSame = False Then
Range("AO" & i) = 1
Range("AO" & D) = 1
Else
Range("AN" & D) = 0
End If
Next D
Next i
End Sub
Anyone can light me about solving this and If anything is not clear about my problem , please feel free to ask
B.R
Polos
Can you try this (not tested on my end)?
Option Explicit
Sub check()
Dim check1, check2 As Variant
Dim i, d As Long
For i = 2 To 74
check1 = Array(Range("F" & i), Range("G" & i), Range("H" & i), Range("I" _
& i), Range("J" & i), Range("K" & i), Range("L" & i), Range("M" & i), _
Range("N" & i), Range("O" & i), Range("P" & i), Range("Q" & i), _
Range("R" & i), Range("S" & i), Range("T" & i), Range("U" & i), _
Range("V" & i), Range("W" & i), Range("X" & i), Range("Y" & i), _
Range("Z" & i), Range("AA" & i), Range("AB" & i), Range("AC" & i), _
Range("AD" & i), Range("AE" & i), Range("AF" & i), Range("AG" & i), _
Range("AH" & i), Range("AI" & i), Range("AJ" & i), Range("AL" & i), _
Range("AM" & i))
For d = 3 To 74
check2 = Array(Range("F" & d), Range("G" & d), Range("H" & d), Range("I" _
& d), Range("J" & d), Range("K" & d), Range("L" & d), Range("M" & d), _
Range("N" & d), Range("O" & d), Range("P" & d), Range("Q" & d), _
Range("R" & d), Range("S" & d), Range("T" & d), Range("U" & d), _
Range("V" & d), Range("W" & d), Range("X" & d), Range("Y" & d), _
Range("Z" & d), Range("AA" & d), Range("AB" & d), Range("AC" & d), _
Range("AD" & d), Range("AE" & d), Range("AF" & d), Range("AG" & d), _
Range("AH" & d), Range("AI" & d), Range("AJ" & d), Range("AL" & d), _
Range("AM" & d))
If Join(check1, Chr(0)) = Join(check2, Chr(0)) Then
Range("AO" & i) = 1
Range("AO" & d) = 1
Else
Range("AN" & d) = 0
End If
Next d
Next i
End Sub