Nested Loop in VBA

[nirvehex]

Hi,

I have a rather lengthy code (for which I apologize for posting the whole thing in case I didn't need too):



Option Explicit


Sub Upload2()
Application.AutoCorrect.AutoFillFormulasInLists = False
Dim sh As Worksheet
Dim LstRw As Long
Dim Rng As Range, c As Range
Dim y As String, T As String, H As String, x As Range, ofset As Long
Dim lRowToCopy As Long

y = "Yes"
T = "TP"
H = "Home"
'Go to recommendations sheet
Set sh = Sheets("Recommendations")
With sh
'Identify container changes in column CH
LstRw = .Cells(.Rows.Count, "CH").End(xlUp).Row
Set Rng = .Range("CH2:CH" & LstRw)
For Each c In Rng.Cells
'If there is a container change and it is TP
If c = y And (c.Offset(0, 14) = T Or c.Offset(0, 14) = H) Then
'Go to Services Export Raw and find same SID in column M and inserts 1 or 2 rows underneath last like SID
Set x = Sheets("Services Export Raw").Range("M:M").Find(what:=c.Offset(, -81).Value, LookAt:=xlWhole, LookIn:=xlFormulas, searchformat:=False)
'If there is a match between SID on services export raw and there is a container change in column CH on recommendations tab insert 1 line
If Not x Is Nothing Then
'Offset set to 1 line
ofset = 1
Do Until x.Offset(ofset) <> c.Offset(, -81).Value
ofset = ofset + 1
Loop
x.Offset(ofset).EntireRow.Insert
'Extra line inserted if Home
If c.Offset(0, 14) = H Then x.Offset(ofset).EntireRow.Insert
'Copy data
'At this line, the value in CH is y (Yes) and the value in CV is either T (TP) or H (Home)
lRowToCopy = x.Row
Select Case c.Offset(0, 14).Value
Case T 'copy certain cells to the single inserted row
'B, C, D, E, F, G, H, I, J, K, M, S, BH, BI, BJ, BK, BM, BS, BV
With Sheets("Services Export Raw")
.Range(.Cells(lRowToCopy, "B"), .Cells(lRowToCopy, "K")).Copy _
Destination:=.Cells(lRowToCopy + 1, "B")
.Range(.Cells(lRowToCopy, "M"), .Cells(lRowToCopy, "M")).Copy _
Destination:=.Cells(lRowToCopy + 1, "M")
.Range(.Cells(lRowToCopy, "S"), .Cells(lRowToCopy, "S")).Copy _
Destination:=.Cells(lRowToCopy + 1, "S")
.Cells(lRowToCopy + 1, "T").Value = "SWO"
.Cells(lRowToCopy + 1, "U").Value = "PERM"
.Cells(lRowToCopy + 1, "V").Value = "OC"
.Cells(lRowToCopy + 1, "W").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BH$" & LstRw & ",56,)"
.Cells(lRowToCopy + 1, "X").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BL$" & LstRw & ",60,)"
'The formula in Y that is written by this formula needs to also be written in any row in column Y where there the variable c = y and c.offset(0, 14) = H
.Cells(lRowToCopy + 1, "Y").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BI$" & LstRw & ",57,)"
.Cells(lRowToCopy + 1, "Z").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BK$" & LstRw & ",59,)"
.Cells(lRowToCopy + 1, "AB").Formula = "=VLOOKUP([@SID],Recommendations!E$3:CT$" & LstRw & ",94,)"
.Cells(lRowToCopy + 1, "AC").Formula = "='Scope of Work'!$B$18"
.Cells(lRowToCopy + 1, "AC").NumberFormat = "mm/dd/yyyy"
.Cells(lRowToCopy + 1, "AD").Formula = "='Scope of Work'!$B$18+7"
.Cells(lRowToCopy + 1, "AD").NumberFormat = "mm/dd/yyyy"
.Cells(lRowToCopy + 1, "AH").Resize(1, 9).Value = "0"
.Cells(lRowToCopy + 1, "AQ").Value = "PER"
.Cells(lRowToCopy + 1, "AR").Value = "EV"
.Cells(lRowToCopy + 1, "AS").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BW$" & LstRw & ",71,)+VLOOKUP([@SID],Recommendations!E$3:BY$" & LstRw & ",73,)"
.Cells(lRowToCopy + 1, "AT").Value = "0"
.Cells(lRowToCopy + 1, "AV").Value = "PER"
.Cells(lRowToCopy + 1, "AW").Value = "EV"
.Cells(lRowToCopy + 1, "AX").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BX$" & LstRw & ",72,)+VLOOKUP([@SID],Recommendations!E$3:BZ$" & LstRw & ",74,)"
.Cells(lRowToCopy + 1, "AY").Value = "0"
.Cells(lRowToCopy + 1, "BG").Value = "1"
.Range(.Cells(lRowToCopy, "BH"), .Cells(lRowToCopy, "BK")).Copy _
Destination:=.Cells(lRowToCopy + 1, "BH")
.Range(.Cells(lRowToCopy, "BM"), .Cells(lRowToCopy, "BM")).Copy _
Destination:=.Cells(lRowToCopy + 1, "BM")
.Cells(lRowToCopy + 1, "BP").Formula = "=CONCATENATE(""Please swap out "",VLOOKUP([@SID],Recommendations!E$3:M$" & LstRw & ",9,),"" "",VLOOKUP([@SID],Recommendations!E$3:Q$" & LstRw & ",13,),"" for a "",VLOOKUP([@SID],Recommendations!E$3:BI$" & LstRw & ",57,),"" "",VLOOKUP([@SID],Recommendations!E$3:BL$" & LstRw & ",60,))"
.Range(.Cells(lRowToCopy, "BS"), .Cells(lRowToCopy, "BS")).Copy _
Destination:=.Cells(lRowToCopy + 1, "BS")
.Cells(lRowToCopy + 1, "BU").Value = .Cells(lRowToCopy + 1, "BP").Value
'.Range(.Cells(lRowToCopy, "BV"), .Cells(lRowToCopy, "BV")).Copy _
Destination:=.Cells(lRowToCopy + 1, "BV")
.Range(.Cells(lRowToCopy, "BY"), .Cells(lRowToCopy, "BY")).Copy _
Destination:=.Cells(lRowToCopy + 1, "BY")
.Cells(lRowToCopy + 1, "CL").Value = "OAKINITCHG"
.Cells(lRowToCopy + 1, "CM").Value = "RGTSIZ"
.Cells(lRowToCopy + 1, "CN").Formula = "='Scope of Work'!$B$26"
.Cells(lRowToCopy + 1, "CO").Formula = "='Scope of Work'!$B$18"
.Cells(lRowToCopy + 1, "CO").NumberFormat = "mm/dd/yyyy"
.Cells(lRowToCopy + 1, "CP").Formula = "='Scope of Work'!$B$24"
.Cells(lRowToCopy + 1, "CQ").Value = "0"
.Cells(lRowToCopy + 1, "CR").Value = "DIS"
End With
Case H 'copy certain cells to the two inserted rows
'B, C, D, E, F, G, H, I, J, K, M, S, BH, BI, BJ, BK, BM, BS, BV, BY, BZ, CD, CE, CF, CG, CH, CI
With Sheets("Services Export Raw")
.Range(.Cells(lRowToCopy, "B"), .Cells(lRowToCopy, "K")).Copy _
Destination:=.Range(.Cells(lRowToCopy + 1, "B"), .Cells(lRowToCopy + 2, "B"))
.Range(.Cells(lRowToCopy, "M"), .Cells(lRowToCopy, "M")).Copy _
Destination:=.Range(.Cells(lRowToCopy + 1, "M"), .Cells(lRowToCopy + 2, "M"))
.Range(.Cells(lRowToCopy, "S"), .Cells(lRowToCopy, "S")).Copy _
Destination:=.Range(.Cells(lRowToCopy + 1, "S"), .Cells(lRowToCopy + 2, "S"))
.Cells(lRowToCopy + 1, "T").Value = "DLV"
.Cells(lRowToCopy + 2, "T").Value = "REM"
.Cells(lRowToCopy + 1, "U").Value = "PERM"
.Cells(lRowToCopy + 2, "U").Value = "PERM"
.Cells(lRowToCopy + 1, "V").Value = "OC"
.Cells(lRowToCopy + 2, "V").Value = "OC"
.Cells(lRowToCopy + 1, "W").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BH$" & LstRw & ",56,)"
.Cells(lRowToCopy + 2, "W").Formula = "=VLOOKUP([@SID],Recommendations!E$3:L$" & LstRw & ",8,)"
.Cells(lRowToCopy + 1, "X").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BL$" & LstRw & ",60,)"
.Cells(lRowToCopy + 2, "X").Formula = "=VLOOKUP([@SID],Recommendations!E$3:Q$" & LstRw & ",13,)"
.Cells(lRowToCopy + 1, "Y").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BI$" & LstRw & ",57,)"
.Cells(lRowToCopy + 2, "Y").Formula = "=VLOOKUP([@SID],Recommendations!E$3:M$" & LstRw & ",9,)"
.Cells(lRowToCopy + 1, "Z").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BK$" & LstRw & ",59,)"
.Cells(lRowToCopy + 2, "Z").Formula = "=VLOOKUP([@SID],Recommendations!E$3:P$" & LstRw & ",12,)"
.Cells(lRowToCopy + 1, "AB").Formula = "=VLOOKUP([@SID],Recommendations!E$3:CT$" & LstRw & ",94,)"
.Cells(lRowToCopy + 2, "AB").Formula = "=VLOOKUP([@SID],Recommendations!E$3:CT$" & LstRw & ",94,)"
.Cells(lRowToCopy + 1, "AC").Formula = "='Scope of Work'!$B$18"
.Cells(lRowToCopy + 1, "AC").NumberFormat = "mm/dd/yyyy"
.Cells(lRowToCopy + 2, "AC").Formula = "='Scope of Work'!$B$18"
.Cells(lRowToCopy + 2, "AC").NumberFormat = "mm/dd/yyyy"
.Cells(lRowToCopy + 1, "AD").Formula = "='Scope of Work'!$B$18+7"
.Cells(lRowToCopy + 1, "AD").NumberFormat = "mm/dd/yyyy"
.Cells(lRowToCopy + 2, "AD").Formula = "='Scope of Work'!$B$18+7"
.Cells(lRowToCopy + 2, "AD").NumberFormat = "mm/dd/yyyy"
.Cells(lRowToCopy + 1, "AH").Resize(1, 9).Value = "0"
.Cells(lRowToCopy + 2, "AH").Resize(1, 9).Value = "0"
.Cells(lRowToCopy + 1, "AQ").Value = "PER"
.Cells(lRowToCopy + 2, "AQ").Value = "PER"
.Cells(lRowToCopy + 1, "AR").Value = "EV"
.Cells(lRowToCopy + 2, "AR").Value = "EV"
.Cells(lRowToCopy + 1, "AS").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BW$" & LstRw & ",71,)"
.Cells(lRowToCopy + 2, "AS").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BY$" & LstRw & ",73,)"
.Cells(lRowToCopy + 1, "AT").Value = "0"
.Cells(lRowToCopy + 2, "AT").Value = "0"
.Cells(lRowToCopy + 1, "AV").Value = "PER"
.Cells(lRowToCopy + 2, "AV").Value = "PER"
.Cells(lRowToCopy + 1, "AW").Value = "EV"
.Cells(lRowToCopy + 2, "AW").Value = "EV"
.Cells(lRowToCopy + 1, "AX").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BX$" & LstRw & ",72,)"
.Cells(lRowToCopy + 2, "AX").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BZ$" & LstRw & ",74,)"
.Cells(lRowToCopy + 1, "AY").Value = "0"
.Cells(lRowToCopy + 2, "AY").Value = "0"
.Cells(lRowToCopy + 1, "BG").Value = "0"
.Cells(lRowToCopy + 2, "BG").Value = "0"
.Range(.Cells(lRowToCopy, "BH"), .Cells(lRowToCopy, "BK")).Copy _
Destination:=.Range(.Cells(lRowToCopy + 1, "BH"), .Cells(lRowToCopy + 2, "BK"))
.Range(.Cells(lRowToCopy, "BM"), .Cells(lRowToCopy, "BM")).Copy _
Destination:=.Range(.Cells(lRowToCopy + 1, "BM"), .Cells(lRowToCopy + 2, "BM"))
.Cells(lRowToCopy + 1, "BP").Formula = "=CONCATENATE(""Please deliver a "",VLOOKUP([@SID],Recommendations!E$3:BI$" & LstRw & ",57,),"" "",VLOOKUP([@SID],Recommendations!E$3:BL$" & LstRw & ",60,))"
.Cells(lRowToCopy + 2, "BP").Formula = "=CONCATENATE(""Please remove the "",VLOOKUP([@SID],Recommendations!E$3:M$" & LstRw & ",9,),"" "",VLOOKUP([@SID],Recommendations!E$3:Q$" & LstRw & ",13,))"
.Range(.Cells(lRowToCopy, "BS"), .Cells(lRowToCopy, "BS")).Copy _
Destination:=.Range(.Cells(lRowToCopy + 1, "BS"), .Cells(lRowToCopy + 2, "BS"))
.Cells(lRowToCopy + 1, "BU").Value = .Cells(lRowToCopy + 1, "BP").Value
.Cells(lRowToCopy + 2, "BU").Value = .Cells(lRowToCopy + 2, "BP").Value
.Range(.Cells(lRowToCopy, "BV"), .Cells(lRowToCopy, "BV")).Copy _
Destination:=.Range(.Cells(lRowToCopy + 1, "BV"), .Cells(lRowToCopy + 2, "BV"))
.Range(.Cells(lRowToCopy, "BY"), .Cells(lRowToCopy, "BZ")).Copy _
Destination:=.Range(.Cells(lRowToCopy + 1, "BY"), .Cells(lRowToCopy + 2, "BZ"))
.Range(.Cells(lRowToCopy, "CD"), .Cells(lRowToCopy, "CI")).Copy _
Destination:=.Range(.Cells(lRowToCopy + 1, "CD"), .Cells(lRowToCopy + 2, "CI"))
.Cells(lRowToCopy + 1, "CL").Value = "OAKINITCHG"
.Cells(lRowToCopy + 2, "CL").Value = "OAKINITCHG"
.Cells(lRowToCopy + 1, "CM").Value = "RGTSIZ"
.Cells(lRowToCopy + 2, "CM").Value = "RGTSIZ"
.Cells(lRowToCopy + 1, "CN").Formula = "='Scope of Work'!$B$26"
.Cells(lRowToCopy + 2, "CN").Formula = "='Scope of Work'!$B$26"
.Cells(lRowToCopy + 1, "CO").Formula = "='Scope of Work'!$B$18"
.Cells(lRowToCopy + 1, "CO").NumberFormat = "mm/dd/yyyy"
.Cells(lRowToCopy + 2, "CO").Formula = "='Scope of Work'!$B$18"
.Cells(lRowToCopy + 2, "CO").NumberFormat = "mm/dd/yyyy"
.Cells(lRowToCopy + 1, "CP").Formula = "='Scope of Work'!$B$24"
.Cells(lRowToCopy + 2, "CP").Formula = "='Scope of Work'!$B$24"
.Cells(lRowToCopy + 1, "CQ").Value = "0"
.Cells(lRowToCopy + 2, "CQ").Value = "0"
.Cells(lRowToCopy + 1, "CR").Value = "DIS"
.Cells(lRowToCopy + 2, "CR").Value = "DIS"
End With
Case Else
Stop ' should not get here
End Select

End If
End If

Next c
End With
Application.AutoCorrect.AutoFillFormulasInLists = True
End Sub





What I want to do now is modify the code to make the following adjustments:

In Case T:

For whatever row there is a blank row inserted, I would like to take what my code writes in column Y of the Services Export Raw tab:



'The formula in Y that is written by this formula needs to also be written in any row in column Y where there the variable c = y and c.offset(0, 14) = H
.Cells(lRowToCopy + 1, "Y").Formula = "=VLOOKUP([@SID],Recommendations!E$3:BI$" & LstRw & ",57,)"


And write this same value in column Y for any matching SID value that the inserted row has. The SID value is in column M and has been copied down from the line above it:



.Range(.Cells(lRowToCopy, "M"), .Cells(lRowToCopy, "M")).Copy _
Destination:=.Cells(lRowToCopy + 1, "M")


So to summarize essentially a blank line is inserted, and then certain cells are copied down, others are written in with formulas. Once this is complete, I want to find the value in Y and then write it over existing values in column Y for all like SIDs that match the SID in the newly inserted line.

In Case H:

I want to do the almost same thing, except replace the values in column Y from the lRowToCopy+1 value in column Y, and write this value over all values in column Y for any matching SID value that this same inserted row has. I want lRowToCopy+2 to remain as is.

I know this is a lot. Can anyone help me out here?

This is cross posted @ http://www.mrexcel.com/forum/excel-questions/917701-nested-loop-visual-basic-applications.html

Thanks!

[p45cal]

Can you supply us a file to play with? (Do some search and replace (but not wholesale, so that we can reasonably test the code we're writing) if the data is sensitive).
In your code comment: "needs to also be written in any row in column Y where the…" can I safely add: "where the SID is the same" ?
Your code is far longer than it needs to be and will be difficult to maintain. I'll have a go at shortening it.
Don't forget to tell the people at MrExcel you've cross posted here.

[nirvehex]

p45cal,

Thank you very much for responding! You are correct in adding "where the SID is the same". How do I upload files? I looked around in the FAQ, but didn't see any instruction. Can you point me to some instructions? Also, my file is very sensitive and will take some time to alter it into a non sensitive file. Let me know if you want me to send the file after or before you have a go at editing the code. Finally, thanks for reminding me to add on the cross post link on Mr. Excel. I've done that.

[p45cal]

When you reply, Go Advanced, Manage Attachments…
I've already edited the code a bit, but there are too many unknowns for me to progress reliably; so ASAP would be good.

[nirvehex]

Hi p45cal,

Attached is the file. Let me know if you have any questions.

Thanks for the help! I really really appreciate it!

[p45cal]

Thoroughly test Upload3 in the attached.

[nirvehex]

Thank you p45cal! That worked perfectly and so much quicker than the last iteration of the incomplete code! I was hoping you could help me expand the code a little bit to some more conditions:


I need to add or build in the following cases. I'm not sure if they would be combined with the other cases or written as separate cases entirely, but I was hoping you could help me with the code some more :)


What I'm trying to do is the following:


1.


For each row the "Recommendations" tab, where column CL = "yes" and column CV = "Home", and for any like SID on the "Services Export Raw" tab and only on the "Services Export Raw" tab rows where ServiceType (col. T) = "PPP" and OccurenceType (col. V) = "SCH":


Then in column CS on the "Services Export Raw" tab put a "1" and in column CT, put something like the other vlookup formulas:



.Cells(lRowToCopy + 1, "CT").Formula = "=VLOOKUP([@SID],Recommendations!E$3:DH$" & LstRw & ",108,)"



2.


For each row on the "Recommendations" tab, where column CL = "yes" and column CV = "TP", and for any like SID on the "Services Export Raw" tab and only on the "Services Export Raw" tab where ServiceType (col. T) = "PPP" and OccurenceType (col. V) = "SCH":


Then in column CS on the "Services Export Raw" tab put a "0"


I've reattached the Demo file that you uploaded last beacuse I added on column "DH" to the "Recommendations" tab. Again, if you could help out with this I really, really appreciate it! And thank you so much for the code you've already written. It worked the first time perfectly and is efficient which is great! Let me know if you have any questions regarding my explanation :)

[p45cal]

I'm sorry, nirvehex, I'm going to bow out of developing this further.
What you're asking for (and what you have asked for and got) takes significant time to develop robustly and I'm not prepared to give what's needed to do it justice, especially as it's obvious this is for commercial purposes.
Others may be prepared to help; perhaps start a new thread?

[SamT]

Yeah, you owe p45cal more than just a just a case of beer.

I will offer a mild critique of your Project.

You currently have 11 Formulas per row which merely enter static data
There are 36 formulas that summarize data
There are ~120 columns in use.
You have 11 separate tables, some of historically static data, some with contemporary data and some with volatile data, all combined into one humongous table.
It appears that data is manually entered one cell at a time by navigating across the 100 odd data columns, and, up and down Rows containing contemporary data


1) It would be far better to have the code LookUp the values and place the value in the cells. When you get to about 500 Rows of data, you will start to see a slow down in performance if you keep using worksheet Formulas.

2) These should be on a separate Daily Summary Report Sheet laid out in a manner that is most logical and intuitive to the User. This leaves every other column as only static historical data or volatile contemporary data.

3 & 4) At the very least, the table should be broken down into 3 more separate sheets, Current, In Bidding and Historical. Both Current and In Bidding would be volatile data. Historical should only contain what is finished to date, including WIP.

5) A VBA UserForm for data entry makes it much easier for the User, by allowing the usage of lists to select from and also goes a long way in preventing typos and other common User mistakes.

[nirvehex]

Thank you p45cal for the code you wrote! Like I said, so far it works perfectly. I understand the need to bow out as it is getting extensive...I'm trying to get my boss to pay for some VBA classes for me as well :) In the meantime, I'm going to take your suggestion and start a new thread.

SamT - thanks for your suggestions. Regarding the tables, this is a format that all users work in within my department and unfortunately it's a constraint that I have to work within at this point. I am interested in using LookUp instead of worksheet formulas, but have no idea how to attempt this. I've been piecing together code the best I can with my limited VBA knowledge. Thank you though. Some day I'll get this complete :)