array nested loops

zrx1200

Well-known Member
Joined
Apr 14, 2010
Messages
605
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
 

zrx1200

Well-known Member
Joined
Apr 14, 2010
Messages
605
Office Version
  1. 2019
Platform
  1. Windows
Well Fluff,

Unless I'm missing something you did a fantastic job at solving the issues at hand! So, you had more insight then you give yourself credit for, and I need to find better ways of conveying whatever...
My initial testing, while light shows the following:
Dupes and math is solved only runs math once on the dupes.
Able to add two dupes (of different names) into list box and math works as it should (omits it).
able to add dupe and new name and math works as it should.
So, the question in my mind becomes:
Running with dictionary (which seems straight forward) does it allow something the arrays wasn't?
I see application taken out and this makes sense now looking at that portion of code.
If I didn't know better the answer lies with the for loop structure you used verses mine, guess is its looping the compare portion just a wee bit different. I need to study some more.

Thanks!
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,890
Office Version
  1. 365
Platform
  1. Windows
With a dictionary you cannot have two keys with the same value, which means there is no need to figure out if you have already run the code for a particular name.
I removed the Max functions as they were only looking at one value & so were redundant.
 

Forum statistics

Threads
1,144,155
Messages
5,722,818
Members
422,460
Latest member
VBA_Noob01

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
Top