Using a loop with multiple conditions-CodePudding

Hi I have a module which uses the value of a ComboBox to determine Which Column ARRAY should be applied when copying information from One WS to a significant number of text boxes on a User Form. There are 8 possible values for the ComboxBox each pulls informarion from a different ARRAY. The row range is the same for all 8 ComboBox Values. I currently have 8 similar sets of Code in the module and am looking for a way to maybe use a series of IF / ELSEIF statements and create a single instance of the Loop Code.

Example Code (Partial - DIm and other lines are omitted for this example)

If cbo1.Value = "Draw 1" Then
    Set ws = Sheets("Sheet1")
     tbCounter = 1
    vCols = Array("B", "C", "D", "E", "F", "G")
    For lngRowLoop = 44 To 56
        For lngCtrlLoop = 0 To UBound(vCols)
        Me.Controls("txtBox" & tbCounter).Text = 
        ws.Range(vCols(lngCtrlLoop) & lngRowLoop).Value
        tbCounter = tbCounter   1
       Next
    Next
    If cbo1.Value = "Draw 2" Then
    Set ws = Sheets("Sheet1")
     tbCounter = 1
    vCols = Array("H", "I", "L", "K", "L", "M")
    For lngRowLoop = 44 To 56
        For lngCtrlLoop = 0 To UBound(vCols)
        Me.Controls("txtBox" & tbCounter).Text = 
        ws.Range(vCols(lngCtrlLoop) & lngRowLoop).Value
        tbCounter = tbCounter   1
       Next
    Next

Is there a solution that will allow for all 8 sets of the variable information to be placed before the Loop Code?

CodePudding user response：

Here is a starter for 10

Option Explicit

' This type definition goes in your class/form module
Private Type State
    
    vcols               As Collection
    tbcounter           As Long

End Type


Private s               As State


' call this method to set up your arrays
Public Sub PopulateVCols()

    Set s.vcols = New Collection
    With s.vcols
    
        .Add Array("B", "C", "D", "E", "F", "G")
        .Add Array("H", "I", "L", "K", "L", "M")
        ' etc
        
    End With
    
End Sub


' Takes an integer starting at 1 to select the vcol array and Sheet
Public Sub DoTheStuffThatNeedsDoing(ByVal ipSelector As Long)
    Set myWs = Sheets("Sheet" & CStr(ipSelector))
    s.tbcounter = 1
    
    For lngRowLoop = 44 To 56
        For lngCtrlLoop = 0 To UBound(vcols.Item(ipSelector))
        Me.Controls("txtBox" & s.tbCounter).Text =
        ws.Range(s.vcols.item(ipselector)) & lngRowLoop).Value
        s.tbcounter = s.tbcounter   1
       Next
    Next

End Sub

CodePudding user response：

You could take advantage of the Dictionary object

Option Explicit

Sub Test()

    Dim cbToColsDict As Object
        Set cbToColsDict = CreateObject("Scripting.Dictionary")
        
            With cbToColsDict
                .Add "Draw 1", Array("B", "C", "D", "E", "F", "G")
                .Add "Draw 2", Array("H", "I", "L", "K", "L", "M")
                '...
            End With

        With Me
        
            Dim vCols As Variant
                vCols = cbToColsDict(.cb01.Value)
                
            Set ws = Worksheet("Sheet1")
            
            Dim tbCounter As Long
                tbCounter = 1
                
                Dim lngRowLoop As Long
                    For lngRowLoop = 44 To 56
                    
                        Dim vCol As Variant
                            For Each vCol In vCols
                                .Controls("txtBox" & tbCounter).Text = ws.Cells(lngRowLoop, vCol).Value
                                tbCounter = tbCounter   1
                            Next
                       
                    Next
                
        End With
End Sub

CodePudding user response：

Populate Multiple Text Boxes

A Quick Fix

Sub PopulateTextBoxesQF()
    
    Dim Cols(): Cols = VBA.Array( _
        VBA.Array("B", "C", "D", "E", "F", "G"), _
        VBA.Array("H", "I", "L", "K", "L", "M"))

    Dim ws As Worksheet: Set ws = Sheets("Sheet1")
    
    Dim dString As String: dString = cob1.Value
    Dim dPos As Long: dPos = InStrRev(dString, " ")   1
    Dim dIndex As Long: dIndex = Mid(dString, dPos, Len(dString) - dPos) - 1
    
    Dim dCols(): dCols = Cols(dIndex)
    Dim dUB As Long: dUB = UBound(dCols)
 
    Dim r As Long, c As Long, tbCounter As Long
   
    For r = 44 To 56
        For c = 0 To dUB
            tbCounter = tbCounter   1
            Me.Controls("txtBox" & tbCounter).Text = ws.Cells(r, dCols(c)).Value
        Next c
    Next r

End Sub

An Improvement

Sub PopulateTextBoxes()
    
    Dim Cols(): Cols = VBA.Array( _
        VBA.Array("B", "C", "D", "E", "F", "G"), _
        VBA.Array("H", "I", "L", "K", "L", "M"))

    Dim ws As Worksheet: Set ws = Sheets("Sheet1")
    Dim rrg As Range: Set rrg = ws.Rows("44:56")
    Dim rCount As Long: rCount = rrg.Rows.Count
    
    Dim dString As String: dString = cob1.Value
    Dim dPos As Long: dPos = InStrRev(dString, " ")   1
    Dim dIndex As Long: dIndex = Mid(dString, dPos, Len(dString) - dPos) - 1
    
    Dim dCols(): dCols = Cols(dIndex)
    Dim dUB As Long: dUB = UBound(dCols)
 
    Dim Data(), r As Long, c As Long, tbCounter As Long
   
    For c = 0 To dUB
        Data = rrg.Columns(dCols(c)).Value
        tbCounter = c   1
        For r = 1 To rCount
            Me.Controls("txtBox" & tbCounter).Text = Data(r, 1)
            tbCounter = tbCounter   dUB   1
        Next r
    Next c

End Sub