multi Loop efficiency

[Chad]

Hi

I was looking for a more efficient way to loop through a number of job
codes.

They go from 301 to 310 and 401 to 410. I am repeating the same code
10 times to get the job done and I was hoping someone could help with
a more efficient method. Problem is I have to increment the name
range by 1 each time.

I only included 2 loops for demonstration purposes.

Thanks in advance
chad

Sub Multiloop()

Dim i As Long
Dim LRw As Long


If Range("AAA").Value = "Phase 301" Or Range("AAA").Value = "Phase
401" Then
LRw = Range("Y" & Rows.Count).End(xlUp).Row
For i = LRw To 1 Step -1
mys = Range("Y" & i).Value
Set FoundCell = Range("C:C").Find(What:=mys, LookIn:=xlValues,
LookAt:=xlWhole, MatchCase:=0)
myint = FoundCell.Row 'Name range increment
Range("G" & myint + 1 & ":" & "U" & myint + 1).Name = "Test" &
"_" & myint + 1
End If
Next i

‘REPEAT CODE * 10 (NOT THAT EFFICIENT).

ElseIf Range("AAA").Value = "Phase 302" Or Range("AAA").Value =
"Phase 402" Then
LRw = Range("Y" & Rows.Count).End(xlUp).Row
For i = LRw To 1 Step -1
mys = Range("Y" & i).Value
Set FoundCell = Range("C:C").Find(What:=mys, LookIn:=xlValues,
LookAt:=xlWhole, MatchCase:=0)
myint = FoundCell.Row 'Name range increment
Range("G" & myint + 2 & ":" & "U" & myint + 2).Name = "Test" &
"_" & myint + 2
Next i

End If

End sub

 

[Per Jessen]

Hi

Try if this should do it:


Dim i As Long
Dim LRw As Long

For X = 1 To 10
TargetVal = 300 + X
TargetVal1 = 400 + X
If Range("AAA").Value = "Phase " & TargetVal Or Range("AAA").Value
= "Phase " & TargetVal1 Then
LRw = Range("Y" & Rows.Count).End(xlUp).Row
For i = LRw To 1 Step -1
mys = Range("Y" & i).Value
Set FoundCell = Range("C:C").Find(What:=mys, LookIn:=xlValues,
LookAt:=xlWhole, MatchCase:=0)
myint = FoundCell.Row 'Name range increment
Range("G" & myint + X & ":" & "U" & myint + 1).Name = "Test" &
"_" & myint + X
End If
Next i
Next

Regards,
Per

 

[Mike]

Select Case Range("AAA").Value
Case Is = "Phase 301", "Phase401"
LRw = Range("Y" & Rows.Count).End(xlUp).Row
For i = LRw To 1 Step -1
mys = Range("Y" & i).Value
Set FoundCell = Range("C:C").Find(What:=mys,
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=0)
myint = FoundCell.Row 'Name range increment
Range("G" & myint + 1 & ":" & "U" & myint + 1).Name = "Test"
& "_" & myint + 1
Next i
Case Is = "Phase 302", "Phase402"
LRw = Range("Y" & Rows.Count).End(xlUp).Row
For i = LRw To 1 Step -1
mys = Range("Y" & i).Value
Set FoundCell = Range("C:C").Find(What:=mys,
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=0)
myint = FoundCell.Row 'Name range increment
Range("G" & myint + 2 & ":" & "U" & myint + 2).Name = "Test"
& "_" & myint + 2
Next i
End Select
End Sub

 

[Per Jessen]

Hi

Just a typo, use this:

Range("G" & myint + X & ":" & "U" & myint + X).Name = "Test" & "_" &
myint + X

regards,
Per

 

[Chad]

Per

Thanks very muchh for your help. It certainly makes the full coding
shorter. Your code works very well with one very small exception. It
makes a named range for each of the scenarios 301 -310 and the same
for the 401-410 series. I was not clear on this so I am very sorry.

I have some code that deletes all the named ranges that start with
"Test" prior to the loop begining.

I need to make one named range if the cell is either 301 or 401. One
range if it is 302 or 402.

I then want to unlock this named range, then protect the sheet so we
can enter data against 301 but no where else on the sheet.

Here is the code in its entirety if this helps.
Chad

Sub Multiloop()

Dim FoundCell As Range
Dim mys As String
Dim myint As Integer
Dim i As Long
Dim LRw As Long
Dim nm As Name

Range("bid_phase").Value = Me.cmbBidPhase.Value
Range("bid_division").Value = Me.cmbBidDivision.Value

'Remove all named ranges starting with Test, to clean sheet.

‘Remove all the names starting with Test
For Each nm In ThisWorkbook.Names
If UCase(Left(nm.Name, 4)) = "TEST" Then
nm.Delete
End If
Next nm
'First part not related to the Per LOOP
LRw = Range("W" & Rows.Count).End(xlUp).Row
If Range("bid_phase").Value = "Phase 900" Then
For i = LRw To 1 Step -1
mys = Range("W" & i).Value
Set FoundCell = Range("B:B").Find(What:=mys, LookIn:=xlValues,
LookAt:=xlWhole, MatchCase:=0)
If FoundCell Is Nothing Then
MsgBox "Not Found"
Else
myint = FoundCell.Row
' Range("B" & myint & ":" & "C" & myint).Interior.Color = vbBlue
Range("G" & myint & ":" & "U" & myint + 3).Name = "Test" & "_" &
myint
End If
Next i

'Per LOOP part where multiple ranges are created. Only one needed

Else
For X = 1 To 10
TargetVal = 300 + X
TargetVal1 = 400 + X
LRw = Range("Y" & Rows.Count).End(xlUp).Row
For i = LRw To 1 Step -1
mys = Range("Y" & i).Value
Set FoundCell = Range("C:C").Find(What:=mys, LookIn:=xlValues,
LookAt:=xlWhole, MatchCase:=0)
myint = FoundCell.Row 'Name range increment
Range("G" & myint + X & ":" & "U" & myint + X).Name = "Test" &
"_" & myint + X

Next i
Next
End If

End Sub

 

[Rick Rothstein]

A little more concise way to write that statement might be...

Cells(myint + X, "G").Resize(, 15).Name = "Test_" & myint + X

--
Rick (MVP - Excel)


Hi

Just a typo, use this:

Range("G" & myint + X & ":" & "U" & myint + X).Name = "Test" & "_" &
myint + X

regards,
Per

 

[Per Jessen]

Hi Chad

Thanks for your reply.

From what you write, I'm not sure how to determine which series should
be chosen and named.

Or maybe it's just me beeing tired..

Regards,
Per

 

[Chad]

Hi Per

Thanks for your help. I will go ahead and do it the long way but your
method would have been so much more elegant. Thanks again for your
help and call it a night now.

Cheers
Chad