VBA – Transfer value from selected Textboxes on Userform to multiple worksheets

[wcm69]

I’m really hoping someone may be able to help me with the following VBA problem:

I have a data entry Userform with 21 textboxes which I’m using to collect the user’s details.
In the first instance I would like the values (data) from all of the textboxes to be transferred to my workbook ‘database’ (Sheet6).

Note. I have managed to find some code on the internet to do this and it works fine on its own.
However - I also need to get selected data (8 to be precise) from the Userform textboxes and transfer those to a second worksheet (Sheet5).

It is at this point that I’m stuck as when I try to modify the code to add the selected data to the second sheet it doesn’t work. To add to my problem the data being transferred to Sheet5 has to start in column: E skip 3 columns (F – H) and then continue from columns: I to O

I’d be grateful if anyone can help out on this one as I’ve tried various ways to modify the code without any success. Unfortunately I’m a VBA novice so I’m hoping it’s just something simple that’s missing and someone’s got the answer.

As usual thank you in advance

Note: the 21 Textboxes are named: “Reg1” to “Reg21”.

The data I need to transfer to Sheet5 (“2^nd Sheet”) is:

Reg17 to (Sheet5) column E
Reg4 to (Sheet5) column I
Reg1 to (Sheet5) column J
Reg12 to (Sheet5) column K
Reg13 to (Sheet5) column L
Reg14 to (Sheet5) column M
Reg9 to (Sheet5) column N
Reg16 to (Sheet5) column 0

The code below (I have tried to modified for the two worksheets) doesn’t work:

Private Sub cmdAdd_Click()
Dim nextrow As Range
Dim x As Integer

'error handler
On Error GoTo errHandler:

'set the next row in the database
Set nextrow = Sheet6.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
'check for values in the first 4 controls
For x = 1 To 4
If Me.Controls("Reg" & x).Value = "" Then
MsgBox "You must add all data"
Exit Sub
End If
Next

'check for duplicate payroll numbers

If WorksheetFunction.CountIf(Sheet6.Range("F:F"), Me.Reg4.Value) > 0 Then
MsgBox "This staff member already exists"
Exit Sub
End If

''''''''''''''''''''''''''''''' below example of my attempt to modify/adapt the code to transfer the selected data to second worksheet (Sheet5) ''''''''''''''''''''

'number of controls to loop through

cNum = 8
'add the data to the database
For x = 1 To cNum

If x = Me.Reg17.Value Then
nextrow = Me.Controls("Reg" & x).Value
Set nextrow = nextrow.Offset(0, 1)
End If

If x = Me.Reg4.Value Then
nextrow = Me.Controls("Reg" & x).Value
Set nextrow = nextrow.Offset(0, 4)
End If

Next
'clear the controls

For x = 1 To cNum
Me.Controls("Reg" & x).Value = ""
Next
'sort the database
Sortit
'error block
On Error GoTo 0
Exit Sub

errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub

Thank again in advance

 

[dmt32]

Hi,
untested but see if this update to your code does what you want

Private Sub cmdAdd_Click()
    Dim nextrow As Long, nextrow2 As Long
    Dim x As Integer, i As Integer, c As Integer
    Dim wsDataBase As Worksheet, wsDataBase2 As Worksheet
    Dim FormData(1 To 21, 1 To 8) As Variant
    
'error handler
    On Error GoTo errHandler
    
    Set wsDataBase = Sheet6
    Set wsDataBase2 = Sheet5
    
'check for duplicate payroll numbers
    If WorksheetFunction.CountIf(wsDataBase.Range("F:F"), Me.Reg4.Value) > 0 Then
        MsgBox "Staff No: " & Me.Reg4.Value & Chr(10) & "This staff member already exists.", 16, "Record Exists"
        Exit Sub
    Else
    
        For x = 1 To 21
            With Me.Controls("Reg" & x)
'check for values in the first 4 controls
                If x < 5 And Len(.Value) = 0 Then
                    MsgBox "You must add all data", 48, "Entry Required"
                    .SetFocus
                    Exit Sub
                Else
'populate database array elements
                    FormData(x, 1) = .Value
                    Select Case x
                    Case 1, 4, 9, 12 To 14, 16 To 17
                        i = i + 1
'populate database2 array  elements
                        FormData(i, 2) = .Value
                    End Select
                End If
            End With
        Next x
            
    End If
        Application.EnableEvents = False
'next row in database
            nextrow = wsDataBase.Cells(wsDataBase.Rows.Count, 3).End(xlUp).Row + 1
'next row in database2
            nextrow2 = wsDataBase2.Cells(wsDataBase2.Rows.Count, 5).End(xlUp).Row + 1
            
            For x = 1 To 21
'output array to database range
                wsDataBase.Cells(nextrow, x + 2).Value = FormData(x, 1)
                If x < 9 Then
'index columns to place data
                c = IIf(x = 1, 5, 7 + x)
'output array to database2 in required order
                wsDataBase2.Cells(nextrow2, c).Value = FormData(Choose(x, 8, 2, 1, 4, 5, 6, 3, 7), 2)
                End If
'clear controls
                Me.Controls("Reg" & x).Text = ""
            Next x
            
                            
'sort the database
    Sortit
                    
                    
errHandler:
    Application.EnableEvents = True
        If Err > 0 Then
            MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
                        & Err.Number & vbCrLf & Err.Description & vbCrLf & _
                        "Please notify the administrator"
        Else
            MsgBox "Record Added To Database", 48, "Record Added"
        End If
End Sub

Dave