Mapping between Multiple Cells and Text Boxes with IF Statements

[Denny57]

I am lookng to find a way to send and receive a large amount of data between multiple textboxes and cells in worksheets without creating a line of code for each textbox. There is also an "IF" element involved.

Example
Command = Call Data (Via a Command Button in a User Form)
If Criteria value = A Then
TextBox1.Value = Sheet 1 Range A1
TextBox2.Value = Sheet 1 Range A2
TextBox3.Value = Sheet 1 Range A3
TextBox3.Value = Sheet 1 Range B1
TextBox5.Value = Sheet 1 Range B2
TextBox6.Value = Sheet 1 Range B3
TextBox7.Value = Sheet 1 Range C1
TextBox8.Value = Sheet 1 Range C2
TextBox9.Value = Sheet 1 Range C3
End If
If Criteria value = B Then
TextBox1.Value = Sheet 1 Range D1
TextBox2.Value = Sheet 1 Range D2
TextBox3.Value = Sheet 1 Range D3
TextBox3.Value = Sheet 1 Range E1
TextBox5.Value = Sheet 1 Range E2
TextBox6.Value = Sheet 1 Range E3
TextBox7.Value = Sheet 1 Range F1
TextBox8.Value = Sheet 1 Range F2
TextBox9.Value = Sheet 1 Range C3
End If

I then need to be able to do this is reverse (upload)

This is only a small sample and I appreciate that I might need to introduce some sequential naming protocol to the textboxes.

Is there some way to code in a way that means that I will not need to insert a line of code for each textbox name into the code (there could be over 50 such textboxes and maybe 8 possible IF conditions).

I appreciate this is not the correct syntax and I can handle the code to search different worksheets should that be necessary, I am hoping that I can drastically reduce the number of lines of code.

Many thanks

 

[dmt32]

Hi,
If your ranges are all contiguous as shown in your example, then you can create range.areas & index the required area with Match function which negates the need for multiple If statements.

A For Next loop can then be used to return the range.areas(index).cells(index) values to your textboxes.

Dave

 

[Denny57]

Hi,
If your ranges are all contiguous as shown in your example, then you can create range.areas & index the required area with Match function which negates the need for multiple If statements.

A For Next loop can then be used to return the range.areas(index).cells(index) values to your textboxes.

Dave

Hi Dave

I am trying to create a userform which will display muliple lottery tickets, their & their returns over a number of draws. The syndicate has 20 lines each with 6 number so 120 potential textboxes refering to a range A1:T6 for the stored numbers in up to 4 draws to give you some idea of the scale. I have no problem writing the code in individual lines but with calls on other sheets for other infomation this could amount to 2000+ lines.

 

[Denny57]

As I am still learning VBA as a "silver surfer" could you possible provide some example code to call and upoad data for 1 ticket of 6 textboxes in 2 draws using the solution you provided.

This would entail calling numbers from a w/s into textboxes Text 1 to Text 6 from cells A1:F1 for 1 If criteria and from cells A2:F2 for another If Criteria. Also the reverse, if possible.

Many thanks

Dave

 

[dmt32]

Hi,
not a young man myself & retired 20+ years ago
Based on your original post code could look something like following

Private Sub CommandButton1_Click()
    Dim m   As Variant
    Dim rng As Range
    Dim i   As Long
   
    'example use only
    CriteriaValue = "B"
   
    'range areas              A     B
    Set rng = Sheet1.Range("A1:C3,D1:F3")
   
    'match criteriavalue to array elements
    m = Application.Match(CriteriaValue, Array("A", "B"), 0)
    If IsError(m) Then Exit Sub
   
    'loop textboxes
    For i = 1 To rng.Areas(m).Cells.Count
        Me.Controls("TextBox" & i).Value = rng.Areas(m).Cells(i).Text
    Next i
   
   
End Sub

Note: I have assumed that you declared variable CriteriaValue elsewhere in your project

this line

'range areas                 A     B
    Set rng = Sheet1.Range("A1:C3,D1:F3")

sets a range object variable to a range that has two Areas

Match function is used to index the array against the criteriavalue which returns the area index value

30-12-2022.xls
	A	B	C	D	E	F
1	A1	B1	C1	D1	E1	F1
2	A2	B2	C2	D2	E2	F2
3	A3	B3	C3	D3	E3	F3
4	AREA A			AREA B
Sheet1

Assuming all your textboxes have retained their default names (TextBox1, TextBox2 etc) - you should be able to loop through the range.area & return cells to the textboxes.

'loop textboxes
    For i = 1 To rng.Areas(m).Cells.Count
        Me.Controls("TextBox" & i).Value = rng.Areas(m).Cells(i).Text
    Next i

This is just an idea which you will need to develop to meet specific project need.

A note of caution, Userforms are quite easy to design but every line of code needs to be created by the developer which even expert users can find troublesome more so with complex forms that have many controls.

Hope Helpful

Dave

 

[Denny57]

Hi,
not a young man myself & retired 20+ years ago
Based on your original post code could look something like following

Private Sub CommandButton1_Click()
    Dim m   As Variant
    Dim rng As Range
    Dim i   As Long
 
    'example use only
    CriteriaValue = "B"
 
    'range areas              A     B
    Set rng = Sheet1.Range("A1:C3,D1:F3")
 
    'match criteriavalue to array elements
    m = Application.Match(CriteriaValue, Array("A", "B"), 0)
    If IsError(m) Then Exit Sub
 
    'loop textboxes
    For i = 1 To rng.Areas(m).Cells.Count
        Me.Controls("TextBox" & i).Value = rng.Areas(m).Cells(i).Text
    Next i
 
 
End Sub

Note: I have assumed that you declared variable CriteriaValue elsewhere in your project

this line

'range areas                 A     B
    Set rng = Sheet1.Range("A1:C3,D1:F3")

sets a range object variable to a range that has two Areas

Match function is used to index the array against the criteriavalue which returns the area index value

30-12-2022.xls
	A	B	C	D	E	F
1	A1	B1	C1	D1	E1	F1
2	A2	B2	C2	D2	E2	F2
3	A3	B3	C3	D3	E3	F3
4	AREA A			AREA B
Sheet1

Assuming all your textboxes have retained their default names (TextBox1, TextBox2 etc) - you should be able to loop through the range.area & return cells to the textboxes.

'loop textboxes
    For i = 1 To rng.Areas(m).Cells.Count
        Me.Controls("TextBox" & i).Value = rng.Areas(m).Cells(i).Text
    Next i

This is just an idea which you will need to develop to meet specific project need.

A note of caution, Userforms are quite easy to design but every line of code needs to be created by the developer which even expert users can find troublesome more so with complex forms that have many controls.

Hope Helpful

Dave

Thank you for this solution.. After some investiagtion I found a similar enquiry which I have been adapting this morning and which works perfectly as I have fixed parameters.

Option Explicit
Dim ctn As Worksheet
Private Sub cmdCallLottoNumbers_Click()

Dim vCols As Variant
Dim lngRowLoop As Long
Dim lngCtrlLoop As Long
Dim tbCounter As Long

    Set ctn = Sheets("Core Ticket Numbers")
    If cboLottoDrawNumbers.Value = "Draw 1" Then
   tbCounter = 1
    vCols = Array("B", "C", "D", "E", "F", "G")

    For lngRowLoop = 4 To 21
        For lngCtrlLoop = 0 To UBound(vCols)
        Me.Controls("txtLottoSelection" & tbCounter).Text = ctn.Range(vCols(lngCtrlLoop) & lngRowLoop).Value
        tbCounter = tbCounter + 1
       Next
    Next
    End If
End Sub

However, I need to be able to update the worksheets with the same TextBox/Cell links so I tried the following Code

Private Sub cmdUpdateLottoNumbers_Click()

Dim vCols As Variant
Dim lngRowLoop As Long
Dim lngCtrlLoop As Long
Dim tbCounter As Long
    Set ctn = Sheets("Core Ticket Numbers")
    If cboLottoDrawNumbers.Value = "Draw 1" Then
    tbCounter = 1
    vCols = Array("B", "C", "D", "E", "F", "G")
    For lngRowLoop = 4 To 21
        For lngCtrlLoop = 0 To UBound(vCols)
      
 'Me.Controls("txtLottoSelection" & tbCounter).Text = ctn.Range(vCols(lngCtrlLoop) & lngRowLoop).Value // TRIED TO REVERSE THIS LINE OF CODE
    [B][I]Me.Controls.ctn.Range(vCols(lngCtrlLoop) & lngRowLoop).Text = ("txtLottoSelection" & tbCounter)[/I][/B]

        tbCounter = tbCounter + 1
       Next
    Next
    End If
End Sub

I am having issues with ebery option I try. When I use a separate line of code for each Textbox, simple reversal of source and target details works fine.
I welcome any suggestions

 

[Denny57]

Thank you for this solution.. After some investiagtion I found a similar enquiry which I have been adapting this morning and which works perfectly as I have fixed parameters.

Option Explicit
Dim ctn As Worksheet
Private Sub cmdCallLottoNumbers_Click()

Dim vCols As Variant
Dim lngRowLoop As Long
Dim lngCtrlLoop As Long
Dim tbCounter As Long

    Set ctn = Sheets("Core Ticket Numbers")
    If cboLottoDrawNumbers.Value = "Draw 1" Then
   tbCounter = 1
    vCols = Array("B", "C", "D", "E", "F", "G")

    For lngRowLoop = 4 To 21
        For lngCtrlLoop = 0 To UBound(vCols)
        Me.Controls("txtLottoSelection" & tbCounter).Text = ctn.Range(vCols(lngCtrlLoop) & lngRowLoop).Value
        tbCounter = tbCounter + 1
       Next
    Next
    End If
End Sub

However, I need to be able to update the worksheets with the same TextBox/Cell links so I tried the following Code

Private Sub cmdUpdateLottoNumbers_Click()

Dim vCols As Variant
Dim lngRowLoop As Long
Dim lngCtrlLoop As Long
Dim tbCounter As Long
    Set ctn = Sheets("Core Ticket Numbers")
    If cboLottoDrawNumbers.Value = "Draw 1" Then
    tbCounter = 1
    vCols = Array("B", "C", "D", "E", "F", "G")
    For lngRowLoop = 4 To 21
        For lngCtrlLoop = 0 To UBound(vCols)
     
 'Me.Controls("txtLottoSelection" & tbCounter).Text = ctn.Range(vCols(lngCtrlLoop) & lngRowLoop).Value // TRIED TO REVERSE THIS LINE OF CODE
    [B][I]Me.Controls.ctn.Range(vCols(lngCtrlLoop) & lngRowLoop).Text = ("txtLottoSelection" & tbCounter)[/I][/B]

        tbCounter = tbCounter + 1
       Next
    Next
    End If
End Sub

I am having issues with ebery option I try. When I use a separate line of code for each Textbox, simple reversal of source and target details works fine.
I welcome any suggestions

Hi I have just found the problem and all works well.. Thank you for your help and Happy New Year