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
Related
I have been trying to create a function with copies the next cell and paste data into same cell but i really do not know how to create it.
Any help will be much appreciated.
Dim Lrow As Long
With Sheet1
Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("C2:C" & Lrow).Copy Sheet7.Range("A2")
.Range("I2:I" & Lrow).Copy Sheet7.Range("C2")
.Range("B2:B" & Lrow).Copy Sheet7.Range("D2")
.Range("G2:G" & Lrow).Copy Sheet7.Range("E2")
.Range("S2:S" & Lrow).Copy Sheet7.Range("F2")
.Range("D2:D" & Lrow).Copy Sheet7.Range("H2")
.Range("E2:E" & Lrow).Copy Sheet7.Range("I2")
.Range("L2:L" & Lrow).Copy Sheet7.Range("J2")
.Range("N2:N" & Lrow).Copy Sheet7.Range("K2")
.Range("Q2:Q" & Lrow).Copy Sheet7.Range("L2")
.Range("R2:R" & Lrow).Copy Sheet7.Range("M2")
.Range("M2:M" & Lrow).Copy Sheet7.Range("N2")
End Wit
Give a try to below codes.
Sub MyCopy()
Dim Lrow As Long
With Sheet1
Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
If Lrow <= 2 Then
Exit Sub
Else
.Range("C" & Lrow).Copy Sheet7.Range("A2")
.Range("I" & Lrow).Copy Sheet7.Range("C2")
.Range("B" & Lrow).Copy Sheet7.Range("D2")
.Range("G" & Lrow).Copy Sheet7.Range("E2")
.Range("S" & Lrow).Copy Sheet7.Range("F2")
.Range("D" & Lrow).Copy Sheet7.Range("H2")
.Range("E" & Lrow).Copy Sheet7.Range("I2")
.Range("L" & Lrow).Copy Sheet7.Range("J2")
.Range("N" & Lrow).Copy Sheet7.Range("K2")
.Range("Q" & Lrow).Copy Sheet7.Range("L2")
.Range("R" & Lrow).Copy Sheet7.Range("M2")
.Range("M" & Lrow).Copy Sheet7.Range("N2")
End If
End With
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 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.
I'm pretty new to VBA and I've been trying to use a macro to paste a few formulas in cells. Problem is, everytime I do so, I get a 1004 error on the very first formula.
I strongly suspect it's because of quotes but I can't for the life of me understand what goes wrong. Would you guys have any idea ?
Sub PREF()
Dim lastrow As Long
lastrow = Range("'Extract WIN'!A" & Rows.Count).End(xlUp).Row
Dim P2 As Worksheet
Set P2 = Sheets("PRO")
Select Case MsgBox("Do you want to proceed with" & P2.[C2].Value & " ?", vbYesNo, "as datepref")
Case vbYes
Sheets("Extract WIN").Select
Range("W2" & ":" & "W" & lastrow).FormulaR1C1 = "=IFERROR(DATEVALUE(CONCATENATE(MID(RC[-10];7;2);""/"";MID(RC[-10];5;2);""/"";MID(RC[-10];1;4)));TEXT(,))"
Range("Y2" & ":" & "Y" & lastrow).FormulaR1C1 = "=IFERROR(DATEVALUE(CONCATENATE(MID(RC[-10];7;2);""/"";MID(RC[-10];5;2);""/"";MID(RC[-10];1;4)));TEXT(,))"
Range("AA2" & ":" & "AA" & lastrow).FormulaR1C1 = "=IFERROR(IF(AND(Provision!R2C3-RC[-4]<366;RC[-18]>0);RC[-18];0);TEXT(,))"
Range("AB2" & ":" & "AB" & lastrow).FormulaR1C1 = "=IFERROR(RC[-1]*RC[-18];TEXT(,))"
Range("AC2" & ":" & "AC" & lastrow).FormulaR1C1 = "=IF(AND(RC[-2]=0;RC[-20]>0;RC[-4]>Provision!R2C6;ISNA(VLOOKUP(RIGHT(TEXT(RC[-25];""000#####"");4);Provision!R7C17:R101C18;1;FAUX))=FAUX);1;0)"
Range("AD2" & ":" & "AD" & lastrow).FormulaR1C1 = "=RC[-1]*RC[-20]"
Range("AE2" & ":" & "AE" & lastrow).FormulaR1C1 = "=IFERROR(RC[-22]-RC[-4]-RC[-2];TEXT(,))"
Range("AF2" & ":" & "AF" & lastrow).FormulaR1C1 = "=IF(AND(RC[-20]>0;RC[-1]>0);ROUND(MIN(RC[-20]*12;RC[-1]);0);0)"
Range("AG2" & ":" & "AG" & lastrow).FormulaR1C1 = "=RC[-1]*RC[-23]"
Range("AH2" & ":" & "AH" & lastrow).FormulaR1C1 = "=RC[-2]-RC[-18]"
Range("AI2" & ":" & "AI" & lastrow).FormulaR1C1 = "=IFERROR(RC[-4]-RC[-3];TEXT(,))"
Range("AJ2" & ":" & "AJ" & lastrow).FormulaR1C1 = "=IF(RC[-24]>0;ROUND(MIN(RC[-24]*12;RC[-1]);0);0)"
Range("AK2" & ":" & "AK" & lastrow).FormulaR1C1 = "=RC[-1]*RC[-27]"
Range("AL2" & ":" & "AL" & lastrow).FormulaR1C1 = "=RC[-2]-RC[-21]"
Range("AM2" & ":" & "AM" & lastrow).FormulaR1C1 = "=IFERROR(RC[-4]-RC[-3];TEXT(,))"
Range("AN2" & ":" & "AN" & lastrow).FormulaR1C1 = "=IF(AND(RC[-16]>Provision!R2C7;RC[-28]>=0);RC[-1];0)"
Range("AO2" & ":" & "AO" & lastrow).FormulaR1C1 = "=IFERROR(RC[-1]*RC[-31];TEXT(,))"
Range("AP2" & ":" & "AP" & lastrow).FormulaR1C1 = "=IF(RC[-18]=TEXT(,);0;IF(AND(X2<Provision!R2C7;RC[-3]>0);RC[-3];0))"
Range("AQ2" & ":" & "AQ" & lastrow).FormulaR1C1 = "=RC[-1]*RC[-33]"
Range("AR2" & ":" & "AR" & lastrow).FormulaR1C1 = "=IF(RC[-20]="""";RC[-5];0)"
Range("AS2" & ":" & "AS" & lastrow).FormulaR1C1 = "=IFERROR(RC[-1]*RC[-35];TEXT(,))"
Range("AT2" & ":" & "AT" & lastrow).FormulaR1C1 = "=IFERROR(RC[-6]+RC[-4]+RC[-2];TEXT(,))"
Range("AU2" & ":" & "AU" & lastrow).FormulaR1C1 = "=IFERROR(RC[-6]+RC[-4]+RC[-2];TEXT(,))"
Range("AV2" & ":" & "AV" & lastrow).FormulaR1C1 = "=IFERROR(RC[-2]-RC[-30];TEXT(,))"
Range("AX2" & ":" & "AX" & lastrow).FormulaR1C1 = "=IFERROR(RC[-13]*0,5;TEXT(,))"
Range("AY2" & ":" & "AY" & lastrow).FormulaR1C1 = "=IFERROR(RC[-4]*0,9;TEXT(,))"
Range("AZ2" & ":" & "AZ" & lastrow).FormulaR1C1 = "=IFERROR(RC[-2]+RC[-1];TEXT(,))"
Range("BA2" & ":" & "BA" & lastrow).FormulaR1C1 = "=IFERROR(RANK(RC[-1];RC:RC;0);TEXT(,))"
Columns("AA:AZ").NumberFormat = "#,##0"
Columns("W:BA").EntireColumn.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
Range("AI2").Select
Sheets("PRO").Select
Case vbNo
P2.[C2].Select
End Select
End Sub
I'm sorry for the wall of code but I have no idea where I did something wrong, and was advised to give you guys full context
You need to replace the ";" with regular ",".
For example, take this line of code:
Range("W2:" & "W" & LastRow).FormulaR1C1 = "=IFERROR(DATEVALUE(CONCATENATE(MID(RC[-10];7;2);""/"";MID(RC[-10];5;2);""/"";MID(RC[-10];1;4)));TEXT(,))"
And change it to this:
Range(Cells(2, 1), Cells(2, LastRow)).FormulaR1C1 = "=IFERROR(DATEVALUE(CONCATENATE(MID(RC[-10],7,2),""/"",MID(RC[-10],5,2),""/"",MID(RC[-10],1,4))),TEXT(,))"
Also, keep in mind I made a few changes to this line. I changed it so that it is using Cells instead of range. I find Cells are easier to work with and provide better readability because we don't have to join any strings.
Either way is fine, it just boils down to preference.
I was wondering how I can paste it starting from row 41. Thanks in advance.
A. Hoek
Sub COPY()
Dim nextrow As Long
Dim i As Integer
i = 41
nextrow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 1
With Sheet1
.Range("a2").COPY Sheet2.Range("A" & nextrow)
.Range("b2").COPY Sheet2.Range("B" & nextrow)
.Range("C2").COPY Sheet2.Range("C" & nextrow)
.Range("d2").COPY Sheet2.Range("D" & nextrow)
.Range("e2").COPY Sheet2.Range("E" & nextrow)
.Range("f2").COPY Sheet2.Range("F" & nextrow)
.Range("g2").COPY Sheet2.Range("G" & nextrow)
End With
End Sub
You mean like this?
Sub COPY()
Dim nextrow As Long
Dim i As Integer
i = 41
nextrow = WorksheetFunction.Max(i, Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 1)
Sheet1.Range("a2:g2").COPY Sheet2.Cells(nextrow, "A")
End Sub
How about:
Sub COPY()
Dim nextrow As Long
Dim i As Integer
i = 41
nextrow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 1
With Sheet1
.Range("a" & i).COPY Sheet2.Range("A" & nextrow)
.Range("b" & i).COPY Sheet2.Range("B" & nextrow)
.Range("C" & i).COPY Sheet2.Range("C" & nextrow)
.Range("d" & i).COPY Sheet2.Range("D" & nextrow)
.Range("e" & i).COPY Sheet2.Range("E" & nextrow)
.Range("f" & i).COPY Sheet2.Range("F" & nextrow)
.Range("g" & i).COPY Sheet2.Range("G" & nextrow)
End With
End Sub