Hi,
I have a rather long section of code that I have been told could be made much simpler by creating a loop routine. I am not very good at VBA and I mostly "cobble together" bits of code I find on here to suit my needs.
A pivot table is sent to me each week which I copy into the workbook with the code.
The code I have at present copies the values of the pivot table into a new workbook and does a lot of other stuff not relevant here. The code works well, but if the standard list gets added to, then the code has to be adjusted to accomodate the change. I am trying to loop through a named range of products so that if the product list grows or shrinks then it wont matter.
I basically want to look down column A on sheet1 to see if any items are missing compared to the standard list in a named range called "ProdPnum".
If an item is missing I want to insert the "ProdPnum" value in column A at the correct row and also the value of (ProdPnum offset one cell right) into column B. I then want to continue this process for as long as there is a value in the named range "ProdPnum".
As I said, I'm not great at VBA and the loops I have tried to adjust to suit, either don't loop or loop forever or just throw up errors.
I have trimmed down the workbook to the bare essentials and commented out some code in the attached workbook for easier reading. The section of code in question is below, and I have attached the workbook.
As always, any help is greatly appreciated.
'check to see if the LGB data is missing and insert it after the "I" if it isSet fndLGB = Worksheets("Sheet1").Columns("B:B").Find(What:="LGB", lookat:=xlWhole)If fndLGB Is Nothing Then Set fndLGB = Worksheets("Sheet1").Columns("B:B").Find(What:="I", lookat:=xlWhole) If Not fndLGB Is Nothing Then fndLGB.Offset(1).EntireRow.Insert fndLGB.Offset(1).Value = "LGB" fndLGB.Offset(1, -1).Value = "653801A" End IfEnd If'check to see if the RGB data is missing and insert it after the "K" if it isSet fndRGB = Worksheets("Sheet1").Columns("B:B").Find(What:="RGB", lookat:=xlWhole)If fndRGB Is Nothing Then Set fndRGB = Worksheets("Sheet1").Columns("B:B").Find(What:="K", lookat:=xlWhole) If Not fndRGB Is Nothing Then fndRGB.Offset(1).EntireRow.Insert fndRGB.Offset(1).Value = "RGB" fndRGB.Offset(1, -1).Value = "652301A" End IfEnd If'check to see if the L1 data is missing and insert it after the "RGB" if it isSet fndL1 = Worksheets("Sheet1").Columns("B:B").Find(What:="L1", lookat:=xlWhole)If fndL1 Is Nothing Then Set fndL1 = Worksheets("Sheet1").Columns("B:B").Find(What:="RGB", lookat:=xlWhole) If Not fndL1 Is Nothing Then fndL1.Offset(1).EntireRow.Insert fndL1.Offset(1).Value = "L1" fndL1.Offset(1, -1).Value = "683881A" End IfEnd If'check to see if the L2 data is missing and insert it after the "L1" if it isSet fndL2 = Worksheets("Sheet1").Columns("B:B").Find(What:="L2", lookat:=xlWhole)If fndL2 Is Nothing Then Set fndL2 = Worksheets("Sheet1").Columns("B:B").Find(What:="L1", lookat:=xlWhole) If Not fndL2 Is Nothing Then fndL2.Offset(1).EntireRow.Insert fndL2.Offset(1).Value = "L2" fndL2.Offset(1, -1).Value = "683891A" End IfEnd If'check to see if the L3 data is missing and insert it after the "L2" if it isSet fndL3 = Worksheets("Sheet1").Columns("B:B").Find(What:="L3", lookat:=xlWhole)If fndL3 Is Nothing Then Set fndL3 = Worksheets("Sheet1").Columns("B:B").Find(What:="L2", lookat:=xlWhole) If Not fndL3 Is Nothing Then fndL3.Offset(1).EntireRow.Insert fndL3.Offset(1).Value = "L3" fndL3.Offset(1, -1).Value = "948521A" End IfEnd If'check to see if the L4 data is missing and insert it after the "L3" if it isSet fndL4 = Worksheets("Sheet1").Columns("B:B").Find(What:="L4", lookat:=xlWhole)If fndL4 Is Nothing Then Set fndL4 = Worksheets("Sheet1").Columns("B:B").Find(What:="L3", lookat:=xlWhole) If Not fndL4 Is Nothing Then fndL4.Offset(1).EntireRow.Insert fndL4.Offset(1).Value = "L4" fndL4.Offset(1, -1).Value = "948531A" End IfEnd If'check to see if the L5 data is missing and insert it after the "L4" if it isSet fndL5 = Worksheets("Sheet1").Columns("B:B").Find(What:="L5", lookat:=xlWhole)If fndL5 Is Nothing Then Set fndL5 = Worksheets("Sheet1").Columns("B:B").Find(What:="L4", lookat:=xlWhole) If Not fndL5 Is Nothing Then fndL5.Offset(1).EntireRow.Insert fndL5.Offset(1).Value = "L5" fndL5.Offset(1, -1).Value = "683861A" End IfEnd If'check to see if the L7 data is missing and insert it after the "L5" if it isSet fndL7 = Worksheets("Sheet1").Columns("B:B").Find(What:="L7", lookat:=xlWhole)If fndL7 Is Nothing Then Set fndL7 = Worksheets("Sheet1").Columns("B:B").Find(What:="L5", lookat:=xlWhole) If Not fndL7 Is Nothing Then fndL7.Offset(1).EntireRow.Insert fndL7.Offset(1).Value = "L7" fndL7.Offset(1, -1).Value = "683871A" End IfEnd If'check to see if the L6 data is missing and insert it after the "L7" if it isSet fndL6 = Worksheets("Sheet1").Columns("B:B").Find(What:="L6", lookat:=xlWhole)If fndL6 Is Nothing Then Set fndL6 = Worksheets("Sheet1").Columns("B:B").Find(What:="L7", lookat:=xlWhole) If Not fndL6 Is Nothing Then fndL6.Offset(1).EntireRow.Insert fndL6.Offset(1).Value = "L6" fndL6.Offset(1, -1).Value = "683872A" End IfEnd If'check to see if the FFF data is missing and insert it after the "L6" if it isSet fndFFF = Worksheets("Sheet1").Columns("B:B").Find(What:="FFF", lookat:=xlWhole)If fndFFF Is Nothing Then Set fndFFF = Worksheets("Sheet1").Columns("B:B").Find(What:="L6", lookat:=xlWhole) If Not fndFFF Is Nothing Then fndFFF.Offset(1).EntireRow.Insert fndFFF.Offset(1).Value = "FFF" fndFFF.Offset(1, -1).Value = "948501A" End IfEnd If'check to see if the FFR data is missing and insert it after the "FFF" if it isSet fndFFR = Worksheets("Sheet1").Columns("B:B").Find(What:="FFR", lookat:=xlWhole)If fndFFR Is Nothing Then Set fndFFR = Worksheets("Sheet1").Columns("B:B").Find(What:="FFF", lookat:=xlWhole) If Not fndFFR Is Nothing Then fndFFR.Offset(1).EntireRow.Insert fndFFR.Offset(1).Value = "FFR" fndFFR.Offset(1, -1).Value = "683831A" End IfEnd If'check to see if the FFL data is missing and insert it after the "FFR" if it isSet fndFFL = Worksheets("Sheet1").Columns("B:B").Find(What:="FFL", lookat:=xlWhole)If fndFFL Is Nothing Then Set fndFFL = Worksheets("Sheet1").Columns("B:B").Find(What:="FFR", lookat:=xlWhole) If Not fndFFL Is Nothing Then fndFFL.Offset(1).EntireRow.Insert fndFFL.Offset(1).Value = "FFL" fndFFL.Offset(1, -1).Value = "683841A" End IfEnd If'check to see if the R1 data is missing and insert it after the "FFL" if it isSet fndR1 = Worksheets("Sheet1").Columns("B:B").Find(What:="R1", lookat:=xlWhole)If fndR1 Is Nothing Then Set fndR1 = Worksheets("Sheet1").Columns("B:B").Find(What:="FFL", lookat:=xlWhole) If Not fndR1 Is Nothing Then fndR1.Offset(1).EntireRow.Insert fndR1.Offset(1).Value = "R1" fndR1.Offset(1, -1).Value = "683941A" End IfEnd If'check to see if the R2 data is missing and insert it after the "R1" if it isSet fndR2 = Worksheets("Sheet1").Columns("B:B").Find(What:="R2", lookat:=xlWhole)If fndR2 Is Nothing Then Set fndR2 = Worksheets("Sheet1").Columns("B:B").Find(What:="R1", lookat:=xlWhole) If Not fndR2 Is Nothing Then fndR2.Offset(1).EntireRow.Insert fndR2.Offset(1).Value = "R2" fndR2.Offset(1, -1).Value = "683951A" End IfEnd If'check to see if the R3 data is missing and insert it after the "R2" if it isSet fndR3 = Worksheets("Sheet1").Columns("B:B").Find(What:="R3", lookat:=xlWhole)If fndR3 Is Nothing Then Set fndR3 = Worksheets("Sheet1").Columns("B:B").Find(What:="R2", lookat:=xlWhole) If Not fndR3 Is Nothing Then fndR3.Offset(1).EntireRow.Insert fndR3.Offset(1).Value = "R3" fndR3.Offset(1, -1).Value = "948541A" End IfEnd If'check to see if the R4 data is missing and insert it after the "R3" if it isSet fndR4 = Worksheets("Sheet1").Columns("B:B").Find(What:="R4", lookat:=xlWhole)If fndR4 Is Nothing Then Set fndR4 = Worksheets("Sheet1").Columns("B:B").Find(What:="R3", lookat:=xlWhole) If Not fndR4 Is Nothing Then fndR4.Offset(1).EntireRow.Insert fndR4.Offset(1).Value = "R4" fndR4.Offset(1, -1).Value = "948551A" End IfEnd If'check to see if the R5 data is missing and insert it after the "R4" if it isSet fndR5 = Worksheets("Sheet1").Columns("B:B").Find(What:="R5", lookat:=xlWhole)If fndR5 Is Nothing Then Set fndR5 = Worksheets("Sheet1").Columns("B:B").Find(What:="R4", lookat:=xlWhole) If Not fndR5 Is Nothing Then fndR5.Offset(1).EntireRow.Insert fndR5.Offset(1).Value = "R5" fndR5.Offset(1, -1).Value = "683921A" End IfEnd If'check to see if the R7 data is missing and insert it after the "R5" if it isSet fndR7 = Worksheets("Sheet1").Columns("B:B").Find(What:="R7", lookat:=xlWhole)If fndR7 Is Nothing Then Set fndR7 = Worksheets("Sheet1").Columns("B:B").Find(What:="R5", lookat:=xlWhole) If Not fndR7 Is Nothing Then fndR7.Offset(1).EntireRow.Insert fndR7.Offset(1).Value = "R7" fndR7.Offset(1, -1).Value = "683931A" End IfEnd If'check to see if the R6 data is missing and insert it after the "R7" if it isSet fndR6 = Worksheets("Sheet1").Columns("B:B").Find(What:="R6", lookat:=xlWhole)If fndR6 Is Nothing Then Set fndR6 = Worksheets("Sheet1").Columns("B:B").Find(What:="R7", lookat:=xlWhole) If Not fndR6 Is Nothing Then fndR6.Offset(1).EntireRow.Insert fndR6.Offset(1).Value = "R6" fndR6.Offset(1, -1).Value = "683932A" End IfEnd If
You should use a sub routine and call it into your code like
Sub FindDataAndReplaceIt(FindData As String, Replace1 As String, Replace2 As String)'check to see if the LGB data is missing and insert it after the "I" if it isSet fndData = Worksheets("Tabelle1").Columns("B:B").Find(What:=Replace1, lookat:=xlWhole)If fndData Is Nothing Then Set fndData = Worksheets("Tabelle1").Columns("B:B").Find(What:=FindData, lookat:=xlWhole) If Not fndData Is Nothing Then fndData.Offset(1).EntireRow.Insert fndData.Offset(1).Value = Replace1 fndData.Offset(1, -1).Value = Replace2 End IfEnd IfEnd SubSub CopyCalloff()' your codeCall FindDataAndReplaceIt("I", "LGB", "653801A")Call FindDataAndReplaceIt("K", "RGB", "652301A")'Your codeEnd Sub
Thanks for the comment Rgonzo, but if I understand you correctly the "myArray" (line 3 of ReadArray) looks like I have to name all the variables in the list.
Or am I missing something?
I probably have the wrong end of the stick but I was hoping that the loop would scroll down the list in "ProdPnum" and populate itself without having to hard code the myArray part.
Rgonzo1971
Hi,
Of course it is possible, but in your code, you don't use all product numbers, so I didn't know which condition applies to trying to complete the data.
Thanks again for sticking with this.
The product part numbers and product codes are listed on the "CodeSheet" in the attachment.
I am still trying to get a way of looping through the part numbers to see if any of them are missing from the new schedule. If they are missing I wanted a new row to be inserted in the correct place according the the "CodeSheet" sequence and the missing item values added to cell a? and b? of that new row.
You should use a sub routine and call it into your code like
Open in new window
and if you want then create an array to loop through your information
Open in new window
Regards