Simplifying code to move frames and populate controls

A

AndyEd

Board Regular
Joined
May 13, 2020
Messages
124
Office Version
  1. 365
Platform
  1. Windows
I have the following code in a cmdUpdate_Click event.

Is there any way to simplify the code. I suspect there is.

VBA Code: 
    With Me
'   NNN.
        If .opt4Yes.Value = False And .opt6Yes.Value = False And .opt8Yes.Value = False Then
            .Fra4.Height = 38
        
            .Fra6.Top = 44
            .Fra6.Height = 38
        
            .Fra8.Top = 82
            .Fra8.Height = 38

'   YYY.
        ElseIf .opt4Yes.Value = True And .opt6Yes.Value = True And .opt8Yes.Value = True Then
            .Fra4.Height = 174
        
            .Fra6.Top = 180
            .Fra6.Height = 174
        
            .Fra8.Top = 354
            .Fra8.Height = 216
        
'   YYN.
        ElseIf .opt4Yes.Value = True And .opt6Yes.Value = True And .opt8Yes.Value = False Then
            .Fra4.Height = 174
        
            .Fra6.Top = 180
            .Fra6.Height = 174
        
            .Fra8.Top = 354
            .Fra8.Height = 38
    
'   NYY.
        ElseIf .opt4Yes.Value = False And .opt6Yes.Value = True And .opt8Yes.Value = True Then
            .Fra4.Height = 38
        
            .Fra6.Top = 44
            .Fra6.Height = 174
        
            .Fra8.Top = 218
            .Fra8.Height = 216
            
'   YNY.
        ElseIf .opt4Yes.Value = True And .opt6Yes.Value = False And .opt8Yes.Value = True Then
            .Fra4.Height = 174
        
            .Fra6.Top = 180
            .Fra6.Height = 38
        
            .Fra8.Top = 218
            .Fra8.Height = 216
            
'   NYN.
        ElseIf .opt4Yes.Value = False And .opt6Yes.Value = True And .opt8Yes.Value = False Then
            .Fra4.Height = 38
        
            .Fra6.Top = 44
            .Fra6.Height = 174
        
            .Fra8.Top = 218
            .Fra8.Height = 38
            
'   YNN.
        ElseIf .opt4Yes.Value = True And .opt6Yes.Value = False And .opt8Yes.Value = False Then
            .Fra4.Height = 174
        
            .Fra6.Top = 180
            .Fra6.Height = 38
        
            .Fra8.Top = 218
            .Fra8.Height = 38
                    
'   NNY.
        ElseIf .opt4Yes.Value = False And .opt6Yes.Value = False And .opt8Yes.Value = True Then
            .Fra4.Height = 38
        
            .Fra6.Top = 44
            .Fra6.Height = 38
        
            .Fra8.Top = 82
            .Fra8.Height = 216
        End If
    
        If .opt4No.Value = True Then
            .txt12.Value = "NA"
            .txt13.Value = "NA"
            .txt14.Value = "NA"
        Else
            .txt12.Value = vbNullString
            .txt13.Value = vbNullString
            .txt14.Value = vbNullString
        End If

        If .opt6No.Value = True Then
            .txt18.Value = "NA"
            .txt19.Value = "NA"
            .txt20.Value = "NA"
        Else
            .txt18.Value = vbNullString
            .txt19.Value = vbNullString
            .txt20.Value = vbNullString
        End If

        If .opt8No.Value = True Then
            .cbo5.Value = "NA"
            .txt24.Value = "NA"
            .txt25.Value = "NA"
            .txt26.Value = "NA"
        Else
            .cbo5.Value = vbNullString
            .txt24.Value = vbNullString
            .txt25.Value = vbNullString
            .txt26.Value = vbNullString
        End If
    End With

End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
try
VBA Code: 
'   NNN.
  If opt4Yes.Value = False And opt6Yes.Value = False And opt8Yes.Value = False Then
    call change_frames(38,44,38,82,38)
'   YYY.
  ElseIf opt4Yes.Value = True And opt6Yes.Value = True And opt8Yes.Value = True Then
    call change_frames(174,180,174,354,216)
'   YYN.
  ElseIf opt4Yes.Value = True And opt6Yes.Value = True And opt8Yes.Value = False Then
    call change_frames(174,180,174,354,38)
'   NYY.
  ElseIf opt4Yes.Value = False And opt6Yes.Value = True And opt8Yes.Value = True Then
    call change_frames(38,44,174,218,216)
'   YNY.
  ElseIf opt4Yes.Value = True And opt6Yes.Value = False And opt8Yes.Value = True Then
    call change_frames(174,180,38,218,216)
'   NYN.
  ElseIf opt4Yes.Value = False And opt6Yes.Value = True And opt8Yes.Value = False Then
    call change_frames(38,44,174,218,38)
'   YNN.
  ElseIf opt4Yes.Value = True And opt6Yes.Value = False And opt8Yes.Value = False Then
    call change_frames(174,180,38,218,38)
'   NNY.
  ElseIf opt4Yes.Value = False And opt6Yes.Value = False And opt8Yes.Value = True Then
    call change_frames(38,44,38,82,216)
  End If

  If opt4No.Value = True Then call opt4_text("NA") Else call opt4_text(vbNullString)
  If opt6No.Value = True Then call opt6_text("NA") Else call opt6_text(vbNullString)
  If opt8No.Value = True Then call opt8_text("NA") Else call opt8_text(vbNullString)
End Sub


Private Sub change_frames(e1,e2,e3,e4,e5)
  Fra4.Height = e1
  Fra6.Top = e2
  Fra6.Height = e3
  Fra8.Top = e4
  Fra8.Height = e5
end sub
Private Sub opt4_text(e1)
  txt12.Value = e1
  txt13.Value = e1
  txt14.Value = e1
End Sub
Private Sub opt6_text(e1)
  txt18.Value = e1
  txt19.Value = e1
  txt20.Value = e1
End Sub
Private Sub opt8_text(e1)
  cbo5.Value = e1
  txt24.Value = e1
  txt25.Value = e1
  txt26.Value = e1
End Sub
 
Upvote 0
There is a way to simplify the code. This code has been reduced from 116 lines to 64 lines.
VBA Code: 
    With Me
        If .opt4Yes.Value = False Then
            .Fra4.Height = 38
            .Fra6.Top = 44
        Else
            .Fra4.Height = 174
            .Fra6.Top = 180
        End If
        
        If .opt8Yes.Value = False Then
            .Fra8.Height = 38
        Else
            .Fra8.Height = 216
        End If
        
        If .opt6Yes.Value = False Then
            .Fra6.Height = 38
        Else
            .Fra6.Height = 174
        End If

        If .opt4Yes.Value = False And .opt6Yes.Value = False Then
            .Fra8.Top = 82
        ElseIf .opt4Yes.Value = True And .opt6Yes.Value = True Then
            .Fra8.Top = 354
        Else
            .Fra8.Top = 218
        End If
        
        If .opt4No.Value = True Then
            .txt12.Value = "NA"
            .txt13.Value = "NA"
            .txt14.Value = "NA"
        Else
            .txt12.Value = vbNullString
            .txt13.Value = vbNullString
            .txt14.Value = vbNullString
        End If

        If .opt6No.Value = True Then
            .txt18.Value = "NA"
            .txt19.Value = "NA"
            .txt20.Value = "NA"
        Else
            .txt18.Value = vbNullString
            .txt19.Value = vbNullString
            .txt20.Value = vbNullString
        End If

        If .opt8No.Value = True Then
            .cbo5.Value = "NA"
            .txt24.Value = "NA"
            .txt25.Value = "NA"
            .txt26.Value = "NA"
        Else
            .cbo5.Value = vbNullString
            .txt24.Value = vbNullString
            .txt25.Value = vbNullString
            .txt26.Value = vbNullString
        End If
    End With

End Sub
 
Upvote 0
Solution
hi
untested but another possible way that removes most of the If statements - MAYBE!

VBA Code: 
Private Sub CommandButton1_Click()
    Dim arr(1 To 3)     As Variant, arr2(1 To 3) As Variant
    Dim i               As Long
  
    For i = 1 To 3
        'load optionbutton selections
        arr(i) = Me.Controls("opt" & Choose(i, 4, 6, 8) & "Yes").Value
    Next i
  
    For i = 1 To 8
        'load permutations
        arr2(1) = Choose(i, False, True, True, False, True, False, True, False)
        arr2(2) = Choose(i, False, True, True, True, False, True, False, False)
        arr2(3) = Choose(i, False, True, False, True, True, False, False, True)
        'test for match
        If Join(arr, ",") = Join(arr2, ",") Then Exit For
    Next i
  
    'configure controls
    With Me
        .Fra4.Height = Choose(i, 38, 174, 174, 38, 174, 38, 174, 38)
      
        .Fra6.Top = Choose(i, 44, 180, 180, 44, 180, 44, 180, 44)
        .Fra6.Height = Choose(i, 38, 174, 174, 174, 174, 180, 174, 38, 38)
      
        .Fra8.Top = Choose(i, 82, 354, 354, 218, 218, 218, 218, 82)
        .Fra8.Height = Choose(i, 38, 216, 38, 216, 216, 38, 38, 216)
      
        .txt12.Value = IIf(arr(1) = True, "NA", vbNullString)
        .txt13.Value = IIf(arr(1) = True, "NA", vbNullString)
        .txt14.Value = IIf(arr(1) = True, "NA", vbNullString)
      
        .txt18.Value = IIf(arr(2) = True, "NA", vbNullString)
        .txt19.Value = IIf(arr(2) = True, "NA", vbNullString)
        .txt20.Value = IIf(arr(2) = True, "NA", vbNullString)
      
        .cbo5.Value = IIf(arr(3) = True, "NA", vbNullString)
        .txt24.Value = IIf(arr(3) = True, "NA", vbNullString)
        .txt25.Value = IIf(arr(3) = True, "NA", vbNullString)
        .txt26.Value = IIf(arr(3) = True, "NA", vbNullString)
      
    End With
  
End Sub

Dave
 
Upvote 0
One more approach:
VBA Code: 
    Dim Ctrl As Control
    With Me
        Select Case OptionState(.opt4Yes, .opt6Yes, .opt8Yes)
            Case "YYY", "YYN", "YNY", "YNN"
                .fra4.Height = 174
            Case "NYY", "NYN", "NNY", "NNN"
                .fra4.Height = 38
            Case "YYY", "YYN", "NYY", "NYN"
                .fra6.Height = 174
            Case "YNY", "YNN", "NNY", "NNN"
                .fra6.Height = 38
            Case "YYY", "YYN", "YNY", "YNN"
                .fra6.Top = 180
            Case "NYY", "NYN", "NNY", "NNN"
                .fra6.Top = 44
            Case "YYY", "YNY", "NYY", "NNY"
                .fra8.Height = 216
            Case "YYN", "YNN", "NYN", "NNN"
                .fra8.Height = 38
            Case "YNY", "YNN", "NYY", "NYN"
                .fra8.Top = 218
            Case "YYY", "YYN"
                .fra8.Top = 354
            Case "NNY", "NNN"
                .fra8.Top = 82
        End Select
        
        For Each Ctrl In Me.Controls
            Select Case Ctrl.Name
                Case "txt12", "txt13", "txt14", "txt18", "txt19", "txt20", "txt24", "txt25", "txt26", "cbo5"
                    Ctrl.Value = vbNullString
            End Select
        Next Ctrl
        If .opt4No.Value = True Then
            .txt12.Value = "NA"
            .txt13.Value = "NA"
            .txt14.Value = "NA"
        End If
        
        If .opt6No.Value = True Then
            .txt18.Value = "NA"
            .txt19.Value = "NA"
            .txt20.Value = "NA"
        End If
        
        If .opt8No.Value = True Then
            .cbo5.Value = "NA"
            .txt24.Value = "NA"
            .txt25.Value = "NA"
            .txt26.Value = "NA"
        End If
    End With

VBA Code: 
Function OptionState(Opt4 As Object, Opt6 As Object, Opt8 As Object) As String
    Dim OBin As String
    OBin = -CInt(Opt4.Value) & -CInt(Opt6.Value) & -CInt(Opt8.Value)
    OBin = Replace(Replace(OBin, "0", "N"), "1", "Y")
    OptionState = OBin
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

Jaafar Tribak
  • Question Question
MultiColor + Drag N Drop ListBox Class (Win32)
Replies
8
Views
3K
Hasson
H
P
  • Question Question
The cell or chart you're trying to change is on a protected sheet. Error upon placing worksheet Change Selection Code
Replies
1
Views
5K
pingme89
P
Jaafar Tribak
  • Question Question
Dragging Controls - Unleashing the power of VBA with Win32 API programming.
Replies
1
Views
5K
Tom.Jones
T
D
  • Question Question
VBA code slowing down workbook
Replies
3
Views
785
Dakar82
D
Jaafar Tribak
  • Question Question
Cool Class for making Floating Shapes !
2
Replies
15
Views
5K
Jaafar Tribak
Jaafar Tribak

Forum statistics

Threads
1,223,792
Messages
6,174,613
Members
452,574
Latest member
hang_and_bang

Share this page

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