array nested loops

zrx1200

Well-known Member
Joined
Apr 14, 2010
Messages
622
Office Version
  1. 2019
Platform
  1. Windows
I have two list boxes. lb1 and lb2. Items are picked from lb1 and transferred to lb2 with command bt. this command bt run this procdure below.
I wish to have the math only run one for items that exist in lb2 more then once and carry on with math for other items (none duplicate) as needed.

The NameTwice is a "switch" I put in the command bt code which does the transfer from lb1 to lb2 to "fake" the array to skip math for the item being duplicated.

This below array procedure is always reran when new (single or multi, items are added) to lb2

VBA Code:
Public Sub TestArrays()
       ' Return time math
'listbox2

Dim Total As Variant
Dim DatalistArray() As Variant
Dim a As Long, b As Long
Dim sh As Worksheet
Dim i As Integer
Dim NameArray() As String
Dim maxtotal As Variant

        Set sh = ThisWorkbook.Sheets("Data")
'        MsgBox NameTwice

With Sheet1.ListBox2
ReDim NameArray(.ListCount)

'Load the listbox2 values into the array
For i = 0 To .ListCount - 1
NameArray(i) = .List(i)
Sheet1.Range("B60").Value = i + 1 'stores counted items for total formula
Next i

'print the array values to the debug window
For i = 0 To UBound(NameArray) - 1
Debug.Print i, NameArray(i)

ReDim Preserve DatalistArray(1 To sh.Range("A" & Rows.count).End(xlUp).Row, 1 To 2) 'was 4 not 2
'load the sheet1 values into DataListArray array
For a = 1 To sh.Range("A" & Rows.count).End(xlUp).Row
For b = 1 To 2
DatalistArray(a, b) = sh.Cells(a, b)
Next b
Next a

For a = 2 To UBound(DatalistArray)
Dim LBname As String
LBname = NameArray(i)
'find if lbname exists in DataListArray(a,1) and pull its data in for math
If DatalistArray(a, 1) = LBname And NameTwice <> 2 Then 'nametwice is varible for more then one occurence of customer in listbox2
'math area
nummax = Format(Application.WorksheetFunction.Max(DatalistArray(a, 2)), "h:mm")
Total = Total + DatalistArray(a, 2)
maxtotal = Format(Application.WorksheetFunction.Max(Total), "h:mm")
Sheet1.Range("b56").Value = nummax
Sheet1.Range("b57").Value = maxtotal
Sheet1.Range("b58").Value = Sheet1.TBRalphTimeLeft.Value
Sheet1.returnTimeRalph = Format(Sheet1.Range("b59"), "h:mm AM/PM")
NameTwice = 0 'reset count varible for more then one occurence of customer in listbox2

Exit For
MsgBox "No match found !"
End If
Next a
Next i
End With

NameTwice = 0 'reset count varible for more then one occurence of customer in listbox2

End Sub
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Ok, lets see if this gets any movement here.

This is the are I think we must work with.
This pulls the LB2 data and compares to the DataListArray to see if match is found. I only want math ran ONCE if many matches are found and math to run on all "single" no matches.

This snipit is now trying to use if, then, else to "step out" so to speak when a single none match comes up, but ones still needs to address matches ?


VBA Code:
For a = 2 To UBound(DatalistArray)
                                                 Dim LBname As String
                                                   LBname = NameArray(i)
                                                    'find if lbname exists in DataListArray(a,1) and pull its data in for math
                                                If DatalistArray(a, 1) = LBname Then  'nametwice is varible for more then one occurence of customer in listbox2
                                                          'math area
                                                          nummax = Format(Application.WorksheetFunction.Max(DatalistArray(a, 2)), "h:mm")
                                                         Total = Total + DatalistArray(a, 2)
                                                         maxtotal = Format(Application.WorksheetFunction.Max(Total), "h:mm")
                                                            Sheet1.Range("b56").Value = nummax
                                                             Sheet1.Range("b57").Value = maxtotal
                                                              Sheet1.Range("b58").Value = Sheet1.TBRalphTimeLeft.Value
                                                               Sheet1.returnTimeRalph = Format(Sheet1.Range("b59"), "h:mm AM/PM")
                                                             NameTwice1 = 0 'reset count varible for more then one occurence of customer in listbox2
'                                                             MsgBox LBname
                                                             
                                                             Exit For
                                                 Else
'                                                 MsgBox "Bypassed"
                                                 End If
'                                                       Exit For
'                                                     MsgBox "No match found !"
'                                                End If
                                   Next a
 
Upvote 0
Why not use Application.Match to see if there are matches?
 
Upvote 0
While, I suppose this is an option, finding a match is not causing an issue, but rather only allowing "math code to run once with multiple matches of the same item. So say listbox2 has the follow Dave,Dave,Dave,Sam,John,John and Joe. In the above procedure its future intent is to loop through items. Do math for Dave once and ignore math for the other 2 Daves, do math once for John ignore next John and finish loop with Joe and do math.
It works fine now, but I want to stop math on multiple (same) past one time (math).
 
Upvote 0
Rather than using an array to store the names, why not use a dictionary, that way you won't have any duplicates.
 
Upvote 0
Rather than using an array to store the names, why not use a dictionary, that way you won't have any duplicates.

Aware of dictionary idea, unfamiliar with operation at this time. I want dupes, this is not the issue, but rather just needing code to be run once with the dupes then ignore dupes.
 
Upvote 0
From what I can see, you are only using the NameArray to check if the name is in the DataListArray & nothing else. Therefore why do you need the duplicates, you are only making life far more difficult than it needs to be.
 
Upvote 0
From what I can see, you are only using the NameArray to check if the name is in the DataListArray & nothing else. Therefore why do you need the duplicates, you are only making life far more difficult than it needs to be.

Dupes tie in later to multiple invoices for same name later in program.
As for where we are now this area sets up times hence "math" area. So for explanation Dave is at time 10 say, and in above occurrence's in listbox2 (post #4 ) 3*10 =30, BUT we are only needing 10 (once) per name, but still need dupe, again for further processing down the program line (which works flawless).
 
Upvote 0
From what I can see, you are only using the NameArray to check if the name is in the DataListArray & nothing else. Therefore why do you need the duplicates, you are only making life far more difficult than it needs to be.

I'm certainly not opposed to changing direction in approach here, but felt this was the way forward. Willing to entertain your direction if you feel I'm on wrong path?
 
Upvote 0
As I have absolutely no idea what you are trying to do, it's very difficult to say if you are going down the wrong path. All I have to work on is the code that you posted which tells me virtually nothing, as I have no idea what your data is like or what you are trying to do with it.
That said I think this should do the same as your code
VBA Code:
Public Sub TestArrays()
   ' Return time math
   'listbox2
   
   Dim Total As Variant
   Dim DatalistArray As Variant
   Dim a As Long, b As Long
   Dim sh As Worksheet
   Dim i As Integer
   Dim Dic As Object
   Dim maxtotal As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   Set sh = ThisWorkbook.Sheets("Data")
   
   With Sheet1.ListBox2
      'Load the listbox2 values into the array
      For i = 0 To .ListCount - 1
         Dic(.List(i)) = Empty
      Next i
      Sheet1.Range("B60").Value = .ListCount 'stores counted items for total formula
   End With
   
   'print the array values to the debug window
   For i = 0 To Dic.Count - 1
      Debug.Print i, Dic.Keys()(i)
      DatalistArray = sh.Range("A1:B" & sh.Range("A" & Rows.Count).End(xlUp).Row).Value2
      For a = 2 To UBound(DatalistArray)
         Dim LBname As String
         LBname = Dic.kys()(i)
         'find if lbname exists in DataListArray(a,1) and pull its data in for math
         If DatalistArray(a, 1) = LBname Then 'nametwice is varible for more then one occurence of customer in listbox2
            'math area
            nummax = Format(DatalistArray(a, 2), "h:mm")
            Total = Total + DatalistArray(a, 2)
            maxtotal = Format(Total, "h:mm")
            Sheet1.Range("b56").Value = nummax
            Sheet1.Range("b57").Value = maxtotal
            Sheet1.Range("b58").Value = Sheet1.TBRalphTimeLeft.Value
            Sheet1.returnTimeRalph = Format(Sheet1.Range("b59"), "h:mm AM/PM")
         End If
      Next a
   Next i
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,788
Messages
6,121,577
Members
449,039
Latest member
Arbind kumar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top