No loop alernatives?

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
4,546
Office Version
  1. 2007
Platform
  1. Windows
Just thought I would ask if there is any way to redo the following sections of code to be non looping.

All of the sections are from the same subroutine, so the variables are related. I have added some code to each section in order to distinguish them a bit, so if it seems like there is duplicate code, that is why.

The goal of all of the sections is to replace the loops, if possible. Thank you for any assistance.

VBA Code:
Sub PossibleNoLoopCandidateTest1()
'
'   Goal is to load absent Student names into an array, determine which names are considered to be unexcused, load those names
'       into a different array and also keep a count of those absents that are loaded into the revised array.
'
'   End Goal is to have an array of names that are unexcused and have the total count of those unexcused names.
'
    Dim AbsentsToBeAdded        As Long
    Dim SourceArrayLoopCounter  As Long
    Dim SourceLastRow           As Long
    Dim AbsentStudentArrayList  As Object                                               ' One dimensional array list
    Dim DumpedExcusesArray      As Variant                                              ' Two dimensinal array
    Dim DumpedNamesArray        As Variant                                              ' Two dimensinal array
'
'   Add students that should be counted as Absent to AbsentStudentArrayList and keep a count of that number
    Set AbsentStudentArrayList = CreateObject("System.Collections.ArrayList")
    AbsentStudentArrayList.Add "Filler Item"                                            ' Add a filler to fill Item(0) of AbsentStudentArrayList
'
    For SourceArrayLoopCounter = 1 To SourceLastRow - 1
        If Not Trim(DumpedExcusesArray(SourceArrayLoopCounter, 1)) = "TU" And _
           Not Trim(DumpedExcusesArray(SourceArrayLoopCounter, 1)) = "SR" And _
           Not Trim(DumpedExcusesArray(SourceArrayLoopCounter, 1)) = "TE" Then          ' If not excused absent then ...
                AbsentStudentArrayList.Add DumpedNamesArray(SourceArrayLoopCounter, 1)  '   Load absent name into a 1D array List, (1) = 1st student, (2) = 2nd student, etc
        End If
    Next
'
    AbsentsToBeAdded = AbsentStudentArrayList.Count - 1                 ' Save the count of Names added to the array list ... - 1 to account for filler
End Sub


VBA Code:
Sub PossibleNoLoopCandidateTest2()
'
'   Goal is to compare list of unexcused absents to array of Student names, if match found then Load "A" into SelectedDayColumnArray, also
'       keep a count of those "A"s that are loaded into the array.
'
'   End Goal is to have an array of "A"s that will then be printed next to matching student name, also a total of all of the "A"s that were added to the array.
'
    Dim AbsentCounter               As Long
    Dim AbsentsAdded                As Long
    Dim AbsentsNotAddedCounter      As Long
    Dim AbsentsToBeAdded            As Long
    Dim TotalStudentCounter         As Long
    Dim AbsentsNotAddedArrayList    As Object                                               ' One dimensional array list
    Dim AbsentStudentArrayList      As Object                                               ' One dimensional array list
    Dim SelectedDayColumnArray()    As Variant                                              ' One dimensional array
    Dim TotalStudentArray()         As Variant                                              ' One dimensional array
'
'   Add students that should be counted as Absent to AbsentStudentArrayList and keep a count of that number
    Set AbsentStudentArrayList = CreateObject("System.Collections.ArrayList")
    AbsentStudentArrayList.Add "Filler Item"                                            ' Add a filler to fill Item(0) of AbsentStudentArrayList
'
'   Add 'A's" to column array, increment Absents, Add Names not added to arrayList
    Set AbsentsNotAddedArrayList = CreateObject("System.Collections.ArrayList")
'
    For AbsentCounter = 1 To AbsentsToBeAdded
        For TotalStudentCounter = 1 To UBound(TotalStudentArray)
            If Application.Trim(AbsentStudentArrayList(AbsentCounter)) = Application.Trim(TotalStudentArray(TotalStudentCounter)) Then    ' Delete leading/trailing spaces
                SelectedDayColumnArray(TotalStudentCounter) = "A"                               ' If match found, Load 'A' into the column array
                AbsentsAdded = AbsentsAdded + 1                                                 ' Increment AbsentsAdded
                Exit For                                                                        ' Exit inner For loop
            End If
        Next
'
        If TotalStudentCounter = UBound(TotalStudentArray) + 1 Then                             ' If a student name is not recognized then ...
            AbsentsNotAddedCounter = AbsentsNotAddedCounter + 1                                 '   Add 1 to the counter
            AbsentsNotAddedArrayList.Add AbsentStudentArrayList(AbsentCounter)                  '   Save the name of the absent student that wasn't added
        End If
    Next
End Sub


VBA Code:
Sub PossibleNoLoopCandidateTest3()
'
'   Goal is add each absent student name from the AbsentsNotAddedArrayList to a string
'
    Dim AbsentsNotAddedArrayList    As Object                                               ' One dimensional array list
    Dim StudentsNotAdded            As String
'
    Set AbsentsNotAddedArrayList = CreateObject("System.Collections.ArrayList")
'
        For Each Student In AbsentsNotAddedArrayList
            StudentsNotAdded = StudentsNotAdded & Student & vbCrLf                              '   Add each name to a message string
        Next
'
        MsgBox "Student(s) unable to be automatically added: " & vbCrLf & vbCrLf & StudentsNotAdded ' Display all names not automatically added
        Debug.Print "Student(s) unable to be automatically added: " & vbCrLf & vbCrLf & StudentsNotAdded ' Display all names not automatically added to the debug window

End Sub
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
It is my understanding that you have to create an Array List by adding the items one at a time so I do not think there is a way to eliminate your loops.
 
Upvote 0
It is my understanding that you have to create an Array List by adding the items one at a time so I do not think there is a way to eliminate your loops.
Thank you @Rick Rothstein for looking at my post. From my understanding the items in the array list are added individually, as you mentioned, can be accessed individually, Copied entirely to another array list or array or range.

That being said, I reworked the code to eliminate the array lists and use all arrays instead.

VBA Code:
    Dim AbsentStudentArray          As Variant                              ' 1D Array
    Dim AbsentsNotAddedArray        As Variant                              ' 1D Array
    Dim DumpedExcusesArray          As Variant                              ' 2D Array of Excuses ... 1,1 2,1 3,1 etc
    Dim DumpedNamesArray            As Variant                              ' 2D Array of potential absent names ... 1,1 2,1 3,1 etc
    Dim SelectedDayColumnArray()    As Variant                              ' 1D Array
    Dim TotalStudentArray()         As Variant                              ' 1D Array

Which brings us to the current 3 sections that loop in the subroutine:


VBA Code:
Sub PossibleNoLoopCandidateTest1()                                                              ' Contains 1 loop
'
    ReDim AbsentStudentArray(1 To SourceLastRow - 1) As Variant
'
    AbsentsToBeAdded = 0                                                                        ' Absents added thus far
'
    For SourceArrayLoopCounter = 1 To SourceLastRow - 1
        If Not Trim(DumpedExcusesArray(SourceArrayLoopCounter, 1)) = "TU" And _
           Not Trim(DumpedExcusesArray(SourceArrayLoopCounter, 1)) = "SR" And _
           Not Trim(DumpedExcusesArray(SourceArrayLoopCounter, 1)) = "TE" Then                  ' If not excused absent then ...
                AbsentsToBeAdded = AbsentsToBeAdded + 1                                         '   Increment AbsentsToBeAdded by 1
'
                AbsentStudentArray(AbsentsToBeAdded) = DumpedNamesArray(SourceArrayLoopCounter, 1)  ' Load absent name into a 1D array(1) = 1st student, (2) = 2nd student, etc
        End If
    Next
'
    ReDim Preserve AbsentStudentArray(1 To AbsentsToBeAdded)                                    ' Resize the array to get rid of the unused portion at the end
End Sub


VBA Code:
Sub PossibleNoLoopCandidateTest2()                                                              ' Contains an outer and inner loop
'
    ReDim AbsentsNotAddedArray(1 To SourceLastRow - 1) As Variant
'
    AbsentsAdded = 0
    AbsentsNotAddedCounter = 0
'
    For AbsentCounter = 1 To AbsentsToBeAdded
        For TotalStudentCounter = 1 To UBound(TotalStudentArray)
            If Application.Trim(AbsentStudentArray(AbsentCounter)) = Application.Trim(TotalStudentArray(TotalStudentCounter)) Then    ' Delete leading/trailing spaces
                SelectedDayColumnArray(TotalStudentCounter) = "A"                               ' If match found, Load 'A' into the column array
                AbsentsAdded = AbsentsAdded + 1                                                 ' Increment AbsentsAdded
                Exit For                                                                        ' Exit inner For loop
            End If
        Next
'
        If TotalStudentCounter = UBound(TotalStudentArray) + 1 Then                             ' If a student name is not recognized then ...
            AbsentsNotAddedCounter = AbsentsNotAddedCounter + 1                                 '   Add 1 to the counter
            AbsentsNotAddedArray(AbsentsNotAddedCounter) = AbsentStudentArray(AbsentCounter)    '   Save the name of the absent student that wasn't added
        End If
    Next
End Sub


VBA Code:
Sub PossibleNoLoopCandidateTest3()                                                              ' Contains 1 loop
'
    If AbsentsNotAddedCounter > 0 Then                                                          ' If we have students that weren't added then ...
        ReDim Preserve AbsentsNotAddedArray(1 To AbsentsNotAddedCounter)                        '   Resize the array to get rid of the unused portion at the end
'
        For Each Student In AbsentsNotAddedArray
            StudentsNotAdded = StudentsNotAdded & Student & vbCrLf                              '   Add each name to a message string
        Next
'
        MsgBox "Student(s) unable to be automatically added: " & vbCrLf & vbCrLf & StudentsNotAdded     ' Display all names not automatically added
        Debug.Print "Student(s) unable to be automatically added: " & vbCrLf & vbCrLf & StudentsNotAdded ' Display all names not automatically added to the debug window
    End If
End Sub

Anybody have any ideas now, that the array lists have been eliminated?
 
Upvote 0
I guess I will have to chalk this up as good as it gets, if there are no other ideas.
 
Upvote 0

Forum statistics

Threads
1,214,651
Messages
6,120,744
Members
448,989
Latest member
mariah3

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