VBA Nested IF compare statement - excel

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.)

Related

Sending Email through Excel VBA Macro From Gmail

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

VBA: Excel Automation using VBA

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.

Cleaning VBA code to reference code instead of duplicating it

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

PasteSpecial method of Range class failed in for loop

Writing macros to copy cells in a different workbook in a specific format.Getting error at different lines everytime I run the code
I tried with unhide cells, selection
For i = 1 To lastrow
If IsEmpty(ThisWorkbook.Sheets("Summary").Range("A" & i).Value) = False Then
If ThisWorkbook.Sheets("Summary").Range("A" & i).Font.Bold = True Then
'Range("A" & i).Copy Range("B" & i)
Set BoldTitle = ThisWorkbook.Sheets("Summary").Range("A" & i)
x = i
Else
ws.Range("A" & i).Value = "Winter I"
BoldTitle.Copy
ws.Range("B" & i).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Summary").Range("A" & i).Copy
ws.Range("C" & i).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Summary").Range("B" & i).Copy
ws.Range("D" & i).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Summary").Range("C" & i).Copy
ws.Range("E" & i).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Summary").Range("D" & i).Copy
ws.Range("F" & i).PasteSpecial xlPasteValues
End If
Else
End If
Next i

Excel VBA-Fixing Row to compare

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

Resources