Transfer values userform to worksheet not adding values in all the cells

[ipbr21054]

Evening,
I am using the code shown below.
The problem is the code shown in Red.

I have a userform that i add a value or select it from a Combobox drop down list.
Using the command buttons the values are then transfered to the worksheet in columns B - H

I noticed that i could transfer the values even without making a selection for two combobox2 & comboBox3
So i added the code in Red to catch this & show the user a Msgbox etc etc.

Now when the code is run you must complete each option before it will transfer to the worksheet.

BUT the problem is that nothing is then entered into the cells in column F and H
Remove the code & it transfers perfect BUT no Msgbox is shown should you not make a selection from ComboBox 2 & ComboBox3

Do you see the error there ?

Private Sub TransferButton_Click()
    
    Dim i As Long
    Dim x As Long
    Dim ctrl As Control
    Dim lastrow As Long

    Cancel = 0
    If TextBox1.Text = "" Then
        Cancel = 1
        MsgBox "CUSTOMER'S NAME FIELD IS EMPTY", vbCritical, "RANGER FIELD EMPTY MESSAGE"
        TextBox1.SetFocus

    ElseIf TextBox2.Text = "" Then
        Cancel = 1
        MsgBox "VIN FIELD IS NOT ENTERED", vbCritical, "RANGER FIELD EMPTY MESSAGE"
        TextBox2.SetFocus

    ElseIf ComboBox1.Text = "" Then
        Cancel = 1
        MsgBox "YEAR IS NOT ENTERED", vbCritical, "RANGER FIELD EMPTY MESSAGE"
        ComboBox1.SetFocus
        
    ElseIf ComboBox2.Text = "" Then
        Cancel = 1
        MsgBox "MAKE A SELECTION NOT SELECTED", vbCritical, "RANGER FIELD EMPTY MESSAGE"
        ComboBox2.SetFocus
        
    ElseIf ComboBox3.Text = "" Then
        Cancel = 1
        MsgBox "FORD PART NUMBER NOT SELECTED", vbCritical, "RANGER FIELD EMPTY MESSAGE"
        ComboBox3.SetFocus

    End If

    If Cancel = 1 Then
        Exit Sub
    End If
    

    Rows("5:5").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B5:H5").Borders.LineStyle = xlContinuous
    Range("B5:H5").Borders.Weight = xlThin
    Range("B5:H5").Interior.ColorIndex = 6
    Range("C5:H5").HorizontalAlignment = xlCenter
    Sheets("RANGER").Range("B5").Select
    Cancel = 0
    
    If Cancel = 1 Then
        Exit Sub
        
    End If
    With ThisWorkbook.Worksheets("RANGER")
        .Range("B5").Value = TextBox1.Text
        .Range("D5").Value = TextBox2.Text
        .Range("E5").Value = "8C KEY"
        .Range("G5").Value = "8C KEY"
        .Range("C5").Value = ComboBox1.Text
        .Range("H5").Value = ComboBox2.Text
        .Range("F5").Value = ComboBox3.Text
    End With
    With Sheets("RANGER")
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 5).End(xlUp).Row
        .Range("A4:H" & x).Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlGuess
    End With
    
    Unload RangerFormKey
    ActiveWorkbook.Save
    MsgBox "DATABASE HAS BEEN UPDATED", vbInformation, "SUCCESSFUL MESSAGE"
    Application.ScreenUpdating = True
    Range("B6").Select
    Range("B5").Select
End Sub

 

[dmt32]

Hi,
not fully tested but see if this update to your code helps

Option Base 1
Private Sub TransferButton_Click()
    
    Dim i               As Integer, j As Integer
    Dim LR              As Long
    Dim DataArr(1 To 7) As Variant, errMsgArr As Variant
    
    errMsgArr = Array("CUSTOMER'S NAME FIELD IS EMPTY", "YEAR IS NOT ENTERED", "VIN FIELD IS NOT ENTERED", _
                        "FORD PART NUMBER NOT SELECTED", "MAKE A SELECTION NOT SELECTED")
    
    For j = 1 To 7
        Select Case j
            Case 4, 6
                DataArr(j) = "8C KEY"
            Case Else
                i = i + 1
                With Choose(i, Me.TextBox1, Me.ComboBox1, Me.TextBox2, Me.ComboBox3, Me.ComboBox2)
                    If Len(.Value) > 0 Then
                        DataArr(j) = .Value
                    Else
                        MsgBox errMsgArr(i), vbCritical, "RANGER FIELD Empty MESSAGE"
                        .SetFocus
                        Exit Sub
                    End If
                End With
        End Select
    Next j
    
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("RANGER")
    
        If .AutoFilterMode Then .AutoFilterMode = False
        .Rows("5:5").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        
        With .Range("B5:H5")
            .Borders.LineStyle = xlContinuous
            .Borders.Weight = xlThin
            .Interior.ColorIndex = 6
            .Value = DataArr
        End With
        
        .Range("C5:H5").HorizontalAlignment = xlCenter
        
        LR = .Cells(.Rows.Count, 5).End(xlUp).Row
        .Range("A4:H" & LR).Sort Key1:=.Range("B5"), Order1:=xlAscending, Header:=xlGuess
    End With
    
    ActiveWorkbook.Save
    Unload Me
    
    Application.ScreenUpdating = True
    MsgBox "DATABASE HAS BEEN UPDATED", vbInformation, "SUCCESSFUL MESSAGE"
    
End Sub

Note Option Base 1 statement at top of the code - This MUST sit at very TOP of your useforms code page OUTSIDE any procedure.

Dave

 

[ipbr21054]

Hi,
This is the code above but i had to move the order of things a little.

Option Base 1
Private Sub TransferButton_Click()
    
    Dim i               As Integer, j As Integer
    Dim LR              As Long
    Dim DataArr(1 To 7) As Variant, errMsgArr As Variant
    
    errMsgArr = Array("CUSTOMER'S NAME FIELD IS EMPTY", "VIN FIELD IS NOT ENTERED", "YEAR IS NOT ENTERED", _
                        "MAKE A SELECTION NOT SELECTED", "FORD PART NUMBER NOT SELECTED")
    
    For j = 1 To 7
        Select Case j
            Case 4, 6
                DataArr(j) = "8C KEY"
            Case Else
                i = i + 1
                With Choose(i, Me.TextBox1, Me.TextBox2, Me.ComboBox1, Me.ComboBox2, Me.ComboBox3)
                    If Len(.Value) > 0 Then
                        DataArr(j) = .Value
                    Else
                        MsgBox errMsgArr(i), vbCritical, "RANGER FIELD Empty MESSAGE"
                        .SetFocus
                        Exit Sub
                    End If
                End With
        End Select
    Next j
    
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("RANGER")
    
        If .AutoFilterMode Then .AutoFilterMode = False
        .Rows("5:5").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        
        With .Range("B5:H5")
            .Borders.LineStyle = xlContinuous
            .Borders.Weight = xlThin
            .Interior.ColorIndex = 6
            .Value = DataArr
        End With
        
        .Range("C5:H5").HorizontalAlignment = xlCenter
        
        LR = .Cells(.Rows.Count, 5).End(xlUp).Row
        .Range("A4:H" & LR).Sort Key1:=.Range("B5"), Order1:=xlAscending, Header:=xlGuess
    End With
    
    ActiveWorkbook.Save
    Unload Me
    
    Application.ScreenUpdating = True
    MsgBox "DATABASE HAS BEEN UPDATED", vbInformation, "SUCCESSFUL MESSAGE"
    
End Sub

All works in respect of only sending to worksheet if all fields are complte.
BUT
There are two save issues.
Column F and H are saved in each others place.

Which of the above looks after where each item is saved in what cell

Thanks

 

[ipbr21054]

Could it be to do with this as i see its not used now.

        .Range("B5").Value = TextBox1.Text
        .Range("D5").Value = TextBox2.Text
        .Range("E5").Value = "8C KEY"
        .Range("G5").Value = "8C KEY"
        .Range("C5").Value = ComboBox1.Text
        .Range("H5").Value = ComboBox2.Text
        .Range("F5").Value = ComboBox3.Text

The order or text boxes etc on form is a different order to the worksheet columns.
Does that make sense.

 

[dmt32]

Hi,
This is the code above but i had to move the order of things a little.

With Choose(i, Me.TextBox1, Me.TextBox2, Me.ComboBox1, Me.ComboBox2, Me.ComboBox3)

[/CODE]

All works in respect of only sending to worksheet if all fields are complte.
BUT
There are two save issues.
Column F and H are saved in each others place.

Which of the above looks after where each item is saved in what cell

Thanks

You altered the order of the CONTROLS in the Choose line

I had the order like this

With Choose(i, Me.TextBox1, Me.ComboBox1, Me.TextBox2, Me.ComboBox3, Me.ComboBox2)

Did you try the code BEFORE making your changes? If not, suggest that you delete the altered code & re-place with code I published.

Dave

 

[ipbr21054]

I did yes and thats why i changed it as the msgbox that pops up didnt replate to the field that wasnt completed.

I am told VIN is not entered etc BUT the cursor is in say the year option.
So i then enter the VIN then told again VIN isnt entered etc etc

with the choose code back to how it was column C & D are the wrong way around

 

[dmt32]

I did yes and thats why i changed it as the msgbox that pops up didnt replate to the field that wasnt completed.

I am told VIN is not entered etc BUT the cursor is in say the year option.
So i then enter the VIN then told again VIN isnt entered etc etc

with the choose code back to how it was column C & D are the wrong way around

If msg prompts are not correct you need to alter their order in this array

errMsgArr = Array("CUSTOMER'S NAME FIELD IS EMPTY", "VIN FIELD IS NOT ENTERED", "YEAR IS NOT ENTERED", _
                        "MAKE A SELECTION NOT SELECTED", "FORD PART NUMBER NOT SELECTED")

The Control order in the the Choose list determines where their data is being placed on your spreadsheet.

Dave

 

[ipbr21054]

Ok got it thanks