We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Solved
Looping problem
Posted on 2012-12-23
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.
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 is
Set 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 If
End If
'check to see if the RGB data is missing and insert it after the "K" if it is
Set 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 If
End If
'check to see if the L1 data is missing and insert it after the "RGB" if it is
Set 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 If
End If
'check to see if the L2 data is missing and insert it after the "L1" if it is
Set 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 If
End If
'check to see if the L3 data is missing and insert it after the "L2" if it is
Set 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 If
End If
'check to see if the L4 data is missing and insert it after the "L3" if it is
Set 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 If
End If
'check to see if the L5 data is missing and insert it after the "L4" if it is
Set 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 If
End If
'check to see if the L7 data is missing and insert it after the "L5" if it is
Set 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 If
End If
'check to see if the L6 data is missing and insert it after the "L7" if it is
Set 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 If
End If
'check to see if the FFF data is missing and insert it after the "L6" if it is
Set 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 If
End If
'check to see if the FFR data is missing and insert it after the "FFF" if it is
Set 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 If
End If
'check to see if the FFL data is missing and insert it after the "FFR" if it is
Set 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 If
End If
'check to see if the R1 data is missing and insert it after the "FFL" if it is
Set 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 If
End If
'check to see if the R2 data is missing and insert it after the "R1" if it is
Set 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 If
End If
'check to see if the R3 data is missing and insert it after the "R2" if it is
Set 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 If
End If
'check to see if the R4 data is missing and insert it after the "R3" if it is
Set 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 If
End If
'check to see if the R5 data is missing and insert it after the "R4" if it is
Set 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 If
End If
'check to see if the R7 data is missing and insert it after the "R5" if it is
Set 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 If
End If
'check to see if the R6 data is missing and insert it after the "R7" if it is
Set 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 If
End If
[X]
Welcome to Experts Exchange
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
- Help others & share knowledge
- Earn cash & points
- Learn & ask questions
3-
3
6 Comments
Active today
Hi,
You should use a sub routine and call it into your code like
and if you want then create an array to loop through your information
Regards
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 is
Set 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 If
End If
End Sub
Sub CopyCalloff()
' your code
Call FindDataAndReplaceIt("I", "LGB", "653801A")
Call FindDataAndReplaceIt("K", "RGB", "652301A")
'Your code
End Sub
and if you want then create an array to loop through your information
Sub ReadArray()
Dim myArray As Variant
myArray = [{"I","LGB","653801A";"K","RGB","652301A"}]
For Idx = 1 To UBound(myArray)
MsgBox myArray(Idx, 1) & myArray(Idx, 2) & myArray(Idx, 3)
Next
End Sub
Regards
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.
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.
Active today
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.
Regards
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.
Regards
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.
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.
Active today
Hi,
you could replace your subsequent finds and inserts with this loop.
Regards
you could replace your subsequent finds and inserts with this loop.
Worksheets("CodeSheet").Activate ' when you are still in the original wbk
Set rng = Range(Range("A2"), Range("B2").End(xlDown))
Worksheets("Sheet1").Activate
' rest of the code then
For Each myRow In rng.Rows
Set isect = Application.Intersect(myRow.Offset(-1, 0), rng)
If Not (isect Is Nothing) Then ' if not first in range
Set fndData = Worksheets("Sheet1").Columns("B:B").Find(What:=myRow.Cells(1, 2).Value, lookat:=xlWhole)
If fndData Is Nothing Then
Set fndData = Worksheets("Sheet1").Columns("B:B").Find(What:=myRow.Cells(1, 2).Offset(-1, 0).Value, lookat:=xlWhole)
If Not fndData Is Nothing Then
fndData.Offset(1).EntireRow.Insert
fndData.Offset(1).Value = myRow.Cells(1, 2).Value
fndData.Offset(1, -1).Value = myRow.Cells(1, 1).Value
End If
End If
Else
If Range("B3") <> myRow.Cells(1, 2).Value Then
Range("A3").EntireRow.Insert
Range("B3").Value = myRow.Cells(1, 2).Value
Range("A3").Value = myRow.Cells(1, 1).Value
End If
End If
Next myRow
Regards
Featured Post
Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.
Question has a verified solution.
If you are experiencing a similar issue, please ask a related question
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications. You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Suggested Courses
Course of the Month9 days, 14 hours left to enroll
722 members asked questions and received personalized solutions in the past 7 days.
Join the community of 500,000 technology professionals and ask your questions.