Excel - Pulling Data from excel sheet to userform-CodePudding

Is anyone able to assist in a VBA code I am trying to run.

I would like the code to pull data from a sheet and put it into a userform, the data I would like will be dependent on three criteria's (textbox1,2 and combobox11)

If the data is not found in sheet1, then search sheet2.

Below is my code.

Private Sub CommandButton3_Click()

    'Search and Display - form
    'search for matching data from the textboxes
    Dim Criteria As Variant
    Criteria = Array(TextBox1.Text, TextBox2.Text, ComboBox11.Text)
    lastrow = Worksheets("WFH Data MFB").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lastrow
        If Worksheets("WFH Data MFB").Cells(i, 1, 2, 3).Value = Criteria Then
            ComboBox8.Text = Worksheets("WFH data MFB").Cells(i, 4).Value 'signature
            ComboBox1.Text = Worksheets("WFH data MFB").Cells(i, 5).Value 'PC Type
            TextBox4.Text = Worksheets("WFH data MFB").Cells(i, 6).Value 'Monitor
            CheckBox3.Value = Worksheets("WFH data MFB").Cells(i, 7).Value 'Keyboard
            CheckBox4.Value = Worksheets("WFH data MFB").Cells(i, 7).Value
            CheckBox5.Value = Worksheets("WFH data MFB").Cells(i, 8).Value 'mouse
            CheckBox6.Value = Worksheets("WFH data MFB").Cells(i, 8).Value
            CheckBox7.Value = Worksheets("WFH data MFB").Cells(i, 9).Value 'Webcam
            CheckBox8.Value = Worksheets("WFH data MFB").Cells(i, 9).Value
            CheckBox9.Value = Worksheets("WFH data MFB").Cells(i, 10).Value 'Headset
            CheckBox10.Value = Worksheets("WFH data MFB").Cells(i, 10).Value
            CheckBox11.Value = Worksheets("WFH data MFB").Cells(i, 11).Value 'Speakers
            CheckBox12.Value = Worksheets("WFH data MFB").Cells(i, 11).Value
            CheckBox13.Value = Worksheets("WFH data MFB").Cells(i, 12).Value 'Laptop risers
            CheckBox14.Value = Worksheets("WFH data MFB").Cells(i, 12).Value
            TextBox3.Text = Worksheets("WFH data MFB").Cells(i, 12).Value 'other
        End If
        
        'if the data isnt in sheet ("MFB") then search sheet ("KPF")
        
        If Worksheets("WFH Data MFB").Cells(i, 1, 2, 3).Value = Criteria.Value = " " Then
            If Worksheets("WFH Data KPF").Cells(i, 1, 2, 3).Value = Criteria Then
                For A = 2 To lastrow
                    If Worksheets("WFH Data MFB").Cells(A, 1, 2, 3).Value = Criteria Then
                        ComboBox8.Text = Worksheets("WFH data KPF").Cells(A, 4).Value 'signature
                        ComboBox1.Text = Worksheets("WFH data KPF").Cells(A, 5).Value 'PC Type
                        TextBox4.Text = Worksheets("WFH data KPF").Cells(A, 6).Value 'Monitor
                        CheckBox3.Value = Worksheets("WFH data KPF").Cells(A, 7).Value 'Keyboard
                        CheckBox4.Value = Worksheets("WFH data KPF").Cells(A, 7).Value
                        CheckBox5.Value = Worksheets("WFH data KPF").Cells(A, 8).Value 'mouse
                        CheckBox6.Value = Worksheets("WFH data KPF").Cells(A, 8).Value
                        CheckBox7.Value = Worksheets("WFH data KPF").Cells(A, 9).Value 'Webcam
                        CheckBox8.Value = Worksheets("WFH data KPF").Cells(A, 9).Value
                        CheckBox9.Value = Worksheets("WFH data KPF").Cells(A, 10).Value 'Headset
                        CheckBox10.Value = Worksheets("WFH data KPF").Cells(A, 10).Value
                        CheckBox11.Value = Worksheets("WFH data KPF").Cells(A, 11).Value 'Speakers
                        CheckBox12.Value = Worksheets("WFH data KPF").Cells(A, 11).Value
                        CheckBox13.Value = Worksheets("WFH data KPF").Cells(A, 12).Value 'Laptop risers
                        CheckBox14.Value = Worksheets("WFH data KPF").Cells(A, 12).Value
                        TextBox3.Text = Worksheets("WFH data KPF").Cells(A, 12).Value 'other
                    End If
    
    Next

End Sub

CodePudding user response：

Here is a possible code:

Private Sub CommandButton3_Click()
    
    'SEARCH AND DISPLAY - FORM
    'Search for matching data from the textboxes
    
    'Declarations.
    Dim VarCriteria As Variant
    Dim WksTarget As Worksheet
    Dim WksWorksheet01 As Worksheet
    Dim WksWorksheet02 As Worksheet
    Dim RngSearch As Range
    Dim RngTarget As Range
    Dim RngPin As Range
    
    'Setting variables.
    VarCriteria = Array(TextBox1.Text, TextBox2.Text, ComboBox11.Text)
    Set WksWorksheet01 = Worksheets("WFH Data MFB")
    Set WksWorksheet02 = Worksheets("WFH Data KPF")
    
    'Setting WksTarget.
    Set WksTarget = WksWorksheet01
    
    'Checkpoint for the second run (with the second worksheet).
CP_Worksheet_Restart:
    
    'Focusing on WksTarget.
    With WksTarget
        
        'Setting RngSearch for the area to be searched in the given worksheet (WksTarget).
        Set RngSearch = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        
        'Checking if there are no data that match the criteria.
        If Excel.WorksheetFunction.CountIfs(RngSearch, VarCriteria(0), RngSearch.Offset(0, 1), VarCriteria(1), RngSearch.Offset(0, 2), VarCriteria(2)) = 0 Then
            
            'If no match is found, checks if we are focused on WksWorksheet02.
            If WksTarget.Name = WksWorksheet02.Name Then
                
                'If we are focusing on WksWorksheet02, the code is sent to CP_No_Match_Found.
                GoTo CP_No_Match_Found
                
            Else
                
                'If we are not focusing on WksWorksheet02, WksTarget is reset and the code is sent back to CP_Worksheet_Restart.
                Set WksTarget = WksWorksheet02
                GoTo CP_Worksheet_Restart
                
            End If
            
        End If
        
        'Setting RngPin as the first cell that matches the first criteria.
        Set RngPin = Nothing
        Set RngPin = RngSearch.Find(What:=VarCriteria(0), _
                                    After:=RngSearch.Cells(RngSearch.Rows.Count, 1), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False, _
                                    SearchFormat:=False)
        
        'Checking if RngPin has been set.
        If Not (RngPin Is Nothing) Then
            'Setting RngTarget.
            Set RngTarget = RngPin
        Else
            'If RngPin is still nothing (it could hardly be the case), checks if we are focused on WksWorksheet02.
            If WksTarget.Name = WksWorksheet02.Name Then
                
                'If we are focusing on WksWorksheet02, the code is sent to CP_No_Match_Found.
                GoTo CP_No_Match_Found
                
            Else
                
                'If we are not focusing on WksWorksheet02, WksTarget is reset and the code is sent back to CP_Worksheet_Restart.
                Set WksTarget = WksWorksheet02
                GoTo CP_Worksheet_Restart
                
            End If
        End If
        
        'Checkpoint for the next targeted range.
CP_Next_Target:
        
        'Checking if RngTarget and the two cells next to it match all 3 criteria.
        If RngTarget.Offset(0, 1).Value = VarCriteria(1) And RngTarget.Offset(0, 2).Value = VarCriteria(2) Then
            
            'If a match is found, the data are reported and the macro is terminated
            ComboBox8.Text = RngTarget.Offset(0, 3).Value 'signature
            ComboBox1.Text = RngTarget.Offset(0, 4).Value 'PC Type
            TextBox4.Text = RngTarget.Offset(0, 5).Value 'Monitor
            CheckBox3.Value = RngTarget.Offset(0, 6).Value 'Keyboard
            CheckBox4.Value = RngTarget.Offset(0, 6).Value
            CheckBox5.Value = RngTarget.Offset(0, 7).Value 'mouse
            CheckBox6.Value = RngTarget.Offset(0, 7).Value
            CheckBox7.Value = RngTarget.Offset(0, 8).Value 'Webcam
            CheckBox8.Value = RngTarget.Offset(0, 8).Value
            CheckBox9.Value = RngTarget.Offset(0, 9).Value 'Headset
            CheckBox10.Value = RngTarget.Offset(0, 9).Value
            CheckBox11.Value = RngTarget.Offset(0, 10).Value 'Speakers
            CheckBox12.Value = RngTarget.Offset(0, 10).Value
            CheckBox13.Value = RngTarget.Offset(0, 11).Value 'Laptop risers
            CheckBox14.Value = RngTarget.Offset(0, 11).Value
            TextBox3.Text = RngTarget.Offset(0, 11).Value 'other
            Exit Sub
            
        Else
            
            'If no match is found, RngTarget is reset to the next cell that matches the first criteria.
            Set RngTarget = RngSearch.Find(What:=VarCriteria(0), _
                                           After:=RngTarget, _
                                           LookIn:=xlValues, _
                                           LookAt:=xlWhole, _
                                           SearchOrder:=xlByRows, _
                                           SearchDirection:=xlNext, _
                                           MatchCase:=False, _
                                           SearchFormat:=False)
            
            'If RngTarget has been set back to RngPin and so no match has been found (it could hardly be the case), an error message is displayed and the macro si terminated. Otherwise the code is sent back to CP_Next_Target.
            If RngTarget.Address = RngPin.Address Then
                MsgBox "No match found for" & vbCrLf & VarCriteria(0) & vbCrLf & VarCriteria(1) & vbCrLf & VarCriteria(2), vbCritical   vbOKOnly, "No match found"
            Else
                GoTo CP_Next_Target
            End If
            
        End If
        
    End With
    
    Exit Sub
    
CP_No_Match_Found:
    
    'An error message is displayed and the macro si terminated.
    MsgBox "No match found for" & vbCrLf & VarCriteria(0) & vbCrLf & VarCriteria(1) & vbCrLf & VarCriteria(2), vbCritical   vbOKOnly, "No match found"
    Exit Sub
    
End Sub

I can't really test it since i don't have the whole form. Better codes might be as well possible. Send feedback.