Loop within a loop based of condition

[ItalianPlatinum]

I am not sure the best way to ask this. I have large code that I am looking to modify to include an additional loop that encloses my current code that has loops within it. The complexity I am struggling with is once I wrap my code within the new loop then it'll always run 2 loops but I only want to run the additional loop if a cell value is present. Before unleashing my whole code on you does the ask make sense? I know it will be hard to formulate without the guts of the code.

 

[Engberg]

Makes sense to me, sounds you'll just want to throw an If-statement in there that determines wether or not the second loop runs.

 

[ItalianPlatinum]

Do you mind if I share the code and you maybe can see an easier way than I can because I cannot quite find one

 

[Engberg]

Please do And a description of the condition you want

 

[ItalianPlatinum]

I tried to cut some basic stuff out that isn't quite of importance to save your time

Sub RUN()
    Dim rws As Long
    Dim Industry$, Bulk$, RUN As Date, RequestDate As Date, GroupW, BROKER, FILTER, Start, ENDD, Duration, TFLAG, WCL, TOTAL, filter2, BulkList
    Dim ws As Worksheet, WsExec As Worksheet, WsSum As Worksheet, WsSec As Worksheet, WsCus As Worksheet, WsALL As Worksheet, WsFT As Worksheet, WsSumC As Worksheet
    Dim lr As Long, lr1 As Long, lr2 As Long, lr3 As Long, LrS As Long, lastrow As Long
    Dim chk
    Dim wsForSheet As Worksheet
    Dim loopRow As Long
    Dim sheetFilter As String
    Dim RNGFilter
    Dim i As Long
    Dim SheetName As String
    Dim t As Single
    Dim rngCell As Range, rngDelete As Range
    Dim a As Variant, b As Variant
    Dim dic As Object
    Dim cad As String
    Dim k As Long
    Dim rng As Range
    Dim vCols As Variant, vRows As Variant
    Dim ii As Long, kk As Long, nrALL As Long
    Dim srcRng As Range, destRng As Range
    Dim srcLastCol As Long, srcNextCol, critRng As Range

'set shortcut for worksheets
Set WsExec = Sheets("Execution")
Set WsSum = Sheets("Summary")
Set WsSec = Sheets("Sec Dis")
Set WsCus = Sheets("Brand Check")
Set WsALL = Sheets("ALL")
Set WsFT = Sheets("Industry Trend")
Set WsSumC = Sheets("Summary By Bulk")

'clear
'clear and unprotect, set time for start day, set ranges
'check if running by Bulk
If (Range("Bulk")) <> "" Then
    chk = MsgBox("Are you sure you want to run by Bulk?", vbYesNo)
    If chk = vbNo Then
        Exit Sub
    End If
End If

'set formatting
'set formatting
'set formatting

'Run Industry trend only if going by Bulk
If Bulk <> "" Then
With WsFT
    .Range("_Department") = Bulk
    .Range("_Group") = "1"
    .Range("_CLOF") = "0"
    .Range("_RequestDate") = RUN
    .Activate
    .Range("A10").CurrentRegion.Delete
End With
Call SecDis2
WsFT.Names.Add Name:="BulkList", RefersTo:=Range("B11")
BulkList = Range("BulkList")

'<<><><><><>FIGURE OUT NEW LOOP FOR BULK LIST INCLUDING CODE BELOW Only if BUlk <> "" but not then do the exact same code<><><><><><>

Else
'clear and set sheet filters

'run sec dist sheet
Call SecDis2

'copy over Brands to each tab

'set for Lot runs and clear then run it

'remove duplicates, generate for filters by leading letter followed by wild card for macro '#'
With WsCus
LrS = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(1, 1)), TrailingMinusNumbers:=True
    .Range("B:B").Cells.ClearContents
    .Range("A:A").RemoveDuplicates Columns:=1, Header:= _
        xlNo
lr = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("B1:B" & lr).Formula = "=A1&""########"""
    .Range("C1:C" & lr).Formula = "=SUMIF('Sec Dis'!$D$11:$D$" & LrS & ",A1&""*"",'Sec Dis'!$E$11:$E$" & LrS & ")"
    .Range("Total").Formula = "=SUM($C$1:$B$" & lr & ")"
TOTAL = .Range("Total")
    .Range("B1:D" & lr).Value = .Range("B1:D" & lr).Value
FILTER = .Range("FILTER")
End With

'check if row limit will be exceeded if so then proceed with running per starting value of Brand transfering to respective sheets
'________________________________________________________________________________________________________________________________
If TOTAL > 1048576 Then

filter2 = WsCus.Range("FILTER2")
Call CreateFilterArrays 'creates combination to reduce the loops

'set for Lot runs and clear then run it
With WsSec
    .Range("_IT") = "C"
    .Range("_OP") = "="
End With

' Run loop for range, clear, run, copy and paste into its respective sheet
  i = 0
  Do Until WsCus.Range("FILTER2").Offset(i, 0) = ""
    filter2 = WsCus.Range("FILTER2").Offset(i, 0)

'apply filter to start loop and activate sheet
With WsSec
    .Range("_VALUE") = filter2
    .Application.Calculation = xlManual
    .Range("A10").CurrentRegion.Delete
    .Activate
End With

    Call SecDis2
 
'after execution copy from source and paste into relative sheet applying formulas
With WsSec
lr1 = .Cells(Rows.Count, "A").End(xlUp).Row 'find the maximum row
        .Range("O10:Q10") = Array("Rounded 2 digit Unit Cost", "For formula", "Same Occurrence")
        .Application.Calculation = xlAutomatic
        .Range("P11:P" & lr1).NumberFormat = "General"
        .Range("O11:O" & lr1).Formula = "=Round(I11/G11, 2)"
If TFLAG = "L" Then
        .Range("P11:P" & lr1).Formula = "=""_""&D11&O11"
Else
        .Range("P11:P" & lr1).Formula = "=""_""&D11&E11&O11"
End If
        .Range("P11:P" & lr1).NumberFormat = "@"
        .Range("O11:P" & lr1).Value = .Range("O11:P" & lr1).Value
'countif formula
  Set dic = CreateObject("Scripting.Dictionary")
  a = .Range("P11:P" & lr1)
  ReDim b(1 To UBound(a, 1), 1 To 1)
  For k = 1 To UBound(a, 1)
      dic(a(k, 1)) = dic(a(k, 1)) + 1
  Next
  For k = 1 To UBound(a, 1)
    b(k, 1) = dic(a(k, 1))
  Next
        .Range("Q11").Resize(UBound(b, 1)).Value = b
Set rng = .Range("Q11:Q" & lr1)
End With

If Application.WorksheetFunction.CountIf(rng, ">1") > 0 Then

'transfer data over to Compare tab
   
End If

'apply filter to start and activate sheet
   
    i = i + 1
Loop

'_____________run just of all no loop________________________________________________________________________
Else

'apply filter to start and activate sheet
    
    Call SecDis2
 
'after execution copy from source and paste into relative sheet applying formulas
With WsSec
lr1 = .Cells(WsSec.Rows.Count, "A").End(xlUp).Row 'find the maximum row
        .Range("O10:Q10") = Array("Rounded 2 digit Unit Cost", "For formula", "Same Occurrence")
        .Application.Calculation = xlAutomatic
        .Range("P11:P" & lr1).NumberFormat = "General"
        .Range("O11:O" & lr1).Formula = "=Round(I11/G11, 2)"
If TFLAG = "L" Then
        .Range("P11:P" & lr1).Formula = "=""_""&D11&O11"
Else
        .Range("P11:P" & lr1).Formula = "=""_""&D11&E11&O11"
End If
        .Range("P11:P" & lr1).NumberFormat = "@"
        .Range("O11:P" & lr1).Value = .Range("O11:P" & lr1).Value
'countif formula
  Set dic = CreateObject("Scripting.Dictionary")
  a = .Range("P11:P" & lr1)
  ReDim b(1 To UBound(a, 1), 1 To 1)
  For k = 1 To UBound(a, 1)
      dic(a(k, 1)) = dic(a(k, 1)) + 1
  Next
  For k = 1 To UBound(a, 1)
    b(k, 1) = dic(a(k, 1))
  Next
        .Range("Q11").Resize(UBound(b, 1)).Value = b
Set rng = .Range("Q11:Q" & lr1)
End With

If Application.WorksheetFunction.CountIf(rng, ">1") > 0 Then

'transfer data over to Compare tab

'if no data to transfer skip to next
End If

'check for excel row limit run for all or by Brand combos
End If

'Bulk check else statement
End If

End Sub

 

[Engberg]

Okay, and this is all working code? What are you trying to do? Where should the new For-loop go and what are we looping over, and what is the condition for it to run or not?

Is it everything below this Else that should get looped? And you already have the condition (Bulk <> "" / Else)

 

[ItalianPlatinum]

This is the condition to do the new loop (Range("Bulk")) <> "" Then

As you can see I tried to start a bit.

The new loop should include all that code after the Else statement that is located after this (sorry missed seeing your Picture - you are correct).
'<<><><><><>FIGURE OUT NEW LOOP FOR BULK LIST INCLUDING CODE BELOW Only if Bulk <> "" but not then do the exact same code<><><><><><>

The new list is this: BulkList = Range("BulkList"). It could be 5 items 50 or 100. So sort of dynamic. There could be a better way like finding the last row I am sure

To answer your first question what I am trying to do. Is I can run by a group (now), but I want to run also by Department. Group runs once for the brands in the group. If the user runs by department it could have many groups in it. So Department will find the list of all the groups in it to then find each brand in each group. Yes I know confusing. But I don't know how else to explain it. It is a Lot management system for Purchase and sales.

 

[Engberg]

This is where i'd put the For-loop then

Sub RUN()
Dim rws As Long
Dim Industry$, Bulk$, RUN As Date, RequestDate As Date, GroupW, BROKER, FILTER, Start, ENDD, Duration, TFLAG, WCL, TOTAL, filter2, BulkList
Dim ws As Worksheet, WsExec As Worksheet, WsSum As Worksheet, WsSec As Worksheet, WsCus As Worksheet, WsALL As Worksheet, WsFT As Worksheet, WsSumC As Worksheet
Dim lr As Long, lr1 As Long, lr2 As Long, lr3 As Long, LrS As Long, lastrow As Long
Dim chk
Dim wsForSheet As Worksheet
Dim loopRow As Long
Dim sheetFilter As String
Dim RNGFilter
Dim i As Long
Dim SheetName As String
Dim t As Single
Dim rngCell As Range, rngDelete As Range
Dim a As Variant, b As Variant
Dim dic As Object
Dim cad As String
Dim k As Long
Dim rng As Range
Dim vCols As Variant, vRows As Variant
Dim ii As Long, kk As Long, nrALL As Long
Dim srcRng As Range, destRng As Range
Dim srcLastCol As Long, srcNextCol, critRng As Range

'set shortcut for worksheets
    Set WsExec = Sheets("Execution")
    Set WsSum = Sheets("Summary")
    Set WsSec = Sheets("Sec Dis")
    Set WsCus = Sheets("Brand Check")
    Set WsALL = Sheets("ALL")
    Set WsFT = Sheets("Industry Trend")
    Set WsSumC = Sheets("Summary By Bulk")

'clear
'clear and unprotect, set time for start day, set ranges
'check if running by Bulk
    If (Range("Bulk")) <> "" Then
        chk = MsgBox("Are you sure you want to run by Bulk?", vbYesNo)
        If chk = vbNo Then
            Exit Sub
        End If
    End If

'set formatting
'set formatting
'set formatting

'Run Industry trend only if going by Bulk

If Bulk <> "" Then
    With WsFT
    .Range("_Department") = Bulk
    .Range("_Group") = "1"
    .Range("_CLOF") = "0"
    .Range("_RequestDate") = RUN
    .Activate
    .Range("A10").CurrentRegion.Delete
    End With
    Call SecDis2
    WsFT.Names.Add Name:="BulkList", RefersTo:=Range("B11")
    BulkList = Range("BulkList")
    '<<><><><><>FIGURE OUT NEW LOOP FOR BULK LIST INCLUDING CODE BELOW Only if BUlk <> "" but not then do the exact same code<><><><><><>
Else
    For Each cell In BulkList ' <<<<<<<<<<< COULD ALSO BE SOMETHING LIKE "For bulkListIndex = 0 To BulkList.Count" IF THAT SUITS YOUR NEEDS BETTER >>>>>>>>>>>>
        'clear and set sheet filters
        
        'run sec dist sheet
        Call SecDis2
        
        'copy over Brands to each tab
        
        'set for Lot runs and clear then run it
        
        'remove duplicates, generate for filters by leading letter followed by wild card for macro '#'
        With WsCus
            LrS = .Cells(Rows.Count, "A").End(xlUp).Row
            .Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 2), Array(1, 1)), TrailingMinusNumbers:=True
            .Range("B:B").Cells.ClearContents
            .Range("A:A").RemoveDuplicates Columns:=1, Header:= _
            xlNo
            lr = .Cells(Rows.Count, "A").End(xlUp).Row
            .Range("B1:B" & lr).Formula = "=A1&""########"""
            .Range("C1:C" & lr).Formula = "=SUMIF('Sec Dis'!$D$11:$D$" & LrS & ",A1&""*"",'Sec Dis'!$E$11:$E$" & LrS & ")"
            .Range("Total").Formula = "=SUM($C$1:$B$" & lr & ")"
            TOTAL = .Range("Total")
            .Range("B1:D" & lr).Value = .Range("B1:D" & lr).Value
            FILTER = .Range("FILTER")
        End With
        
        'check if row limit will be exceeded if so then proceed with running per starting value of Brand transfering to respective sheets
        '________________________________________________________________________________________________________________________________
        If TOTAL > 1048576 Then
            
            filter2 = WsCus.Range("FILTER2")
            Call CreateFilterArrays 'creates combination to reduce the loops
            
            'set for Lot runs and clear then run it
            With WsSec
            .Range("_IT") = "C"
            .Range("_OP") = "="
            End With
            
            ' Run loop for range, clear, run, copy and paste into its respective sheet
            i = 0
            Do Until WsCus.Range("FILTER2").Offset(i, 0) = ""
                filter2 = WsCus.Range("FILTER2").Offset(i, 0)
                
                'apply filter to start loop and activate sheet
                With WsSec
                    .Range("_VALUE") = filter2
                    .Application.Calculation = xlManual
                    .Range("A10").CurrentRegion.Delete
                    .Activate
                End With
                
                Call SecDis2
                
                'after execution copy from source and paste into relative sheet applying formulas
                With WsSec
                    lr1 = .Cells(Rows.Count, "A").End(xlUp).Row 'find the maximum row
                    .Range("O10:Q10") = Array("Rounded 2 digit Unit Cost", "For formula", "Same Occurrence")
                    .Application.Calculation = xlAutomatic
                    .Range("P11:P" & lr1).NumberFormat = "General"
                    .Range("O11:O" & lr1).Formula = "=Round(I11/G11, 2)"
                    
                    If TFLAG = "L" Then
                        .Range("P11:P" & lr1).Formula = "=""_""&D11&O11"
                    Else
                    
                    .Range("P11:P" & lr1).Formula = "=""_""&D11&E11&O11"
                    End If
                    .Range("P11:P" & lr1).NumberFormat = "@"
                    .Range("O11:P" & lr1).Value = .Range("O11:P" & lr1).Value
                    'countif formula
                    Set dic = CreateObject("Scripting.Dictionary")
                    a = .Range("P11:P" & lr1)
                    ReDim b(1 To UBound(a, 1), 1 To 1)
                    
                    For k = 1 To UBound(a, 1)
                        dic(a(k, 1)) = dic(a(k, 1)) + 1
                    Next
                    
                    For k = 1 To UBound(a, 1)
                        b(k, 1) = dic(a(k, 1))
                    Next
                    
                    .Range("Q11").Resize(UBound(b, 1)).Value = b
                    Set rng = .Range("Q11:Q" & lr1)
                End With
                
                If Application.WorksheetFunction.CountIf(rng, ">1") > 0 Then
                    'transfer data over to Compare tab
                End If
                'apply filter to start and activate sheet
                
                i = i + 1
            Loop
            '_____________run just of all no loop________________________________________________________________________
        Else
            'apply filter to start and activate sheet
            Call SecDis2
            
            'after execution copy from source and paste into relative sheet applying formulas
            With WsSec
                lr1 = .Cells(WsSec.Rows.Count, "A").End(xlUp).Row 'find the maximum row
                .Range("O10:Q10") = Array("Rounded 2 digit Unit Cost", "For formula", "Same Occurrence")
                .Application.Calculation = xlAutomatic
                .Range("P11:P" & lr1).NumberFormat = "General"
                .Range("O11:O" & lr1).Formula = "=Round(I11/G11, 2)"
                
                If TFLAG = "L" Then
                    .Range("P11:P" & lr1).Formula = "=""_""&D11&O11"
                Else
                    .Range("P11:P" & lr1).Formula = "=""_""&D11&E11&O11"
                End If
                
                .Range("P11:P" & lr1).NumberFormat = "@"
                .Range("O11:P" & lr1).Value = .Range("O11:P" & lr1).Value
                'countif formula
                Set dic = CreateObject("Scripting.Dictionary")
                a = .Range("P11:P" & lr1)
                ReDim b(1 To UBound(a, 1), 1 To 1)
                
                For k = 1 To UBound(a, 1)
                    dic(a(k, 1)) = dic(a(k, 1)) + 1
                Next
                
                For k = 1 To UBound(a, 1)
                    b(k, 1) = dic(a(k, 1))
                Next
                
                .Range("Q11").Resize(UBound(b, 1)).Value = b
                Set rng = .Range("Q11:Q" & lr1)
            End With
            
            If Application.WorksheetFunction.CountIf(rng, ">1") > 0 Then
                'transfer data over to Compare tab
                'if no data to transfer skip to next
            End If
            'check for excel row limit run for all or by Brand combos
        End If
        'Bulk check else statement
    Next
End If
End Sub

 

[ItalianPlatinum]

But will that always now run with 2 loops regardless?

BulkList <> "" then run for bulk and existing code
BulkList = "" then run for existing code (ignore bulk)

I think I can find a workaround though if that is too in-depth

 

[Engberg]

I'm not really following which 2 loops we are talking about. Are you saying you also want a If-condition at the top of the For-loop I added, so that it only runs if there is a value in the BulkList-cell it is looking at?

If Bulk <> "" Then
    With WsFT
    .Range("_Department") = Bulk
    .Range("_Group") = "1"
    .Range("_CLOF") = "0"
    .Range("_RequestDate") = RUN
    .Activate
    .Range("A10").CurrentRegion.Delete
    End With
    Call SecDis2
    WsFT.Names.Add Name:="BulkList", RefersTo:=Range("B11")
    BulkList = Range("BulkList")
Else
    For Each cell In BulkList
        ' Do you want something like this?
        If cell.Value <> "" Then
           ' (Run everything in the loop)
        Else
           ' (Exit the loop and go to the end of the sub)
         End If
    Next
End If
End Sub