How to VBA code to drop data from UserForm to multiple worksheets

P

Pi_Lover

Board Regular
Joined
Nov 3, 2023
Messages
55
Office Version
  1. 365
Platform
  1. Windows
I am attempting to drop data into multiple worksheets from data entered into a UserForm. I have already had great success from help on here setting it up thus far to drop data into 1 worksheet using a lookup code. But the 1st worksheet will require the lookup function, whereas the 2nd worksheet won't. The 2nd worksheet will only require the data to be dropped into the next available row. Is this possible to do using VBA? See existing code below:

Private Sub CommandButton1_Click()

Dim Lookup As String
Dim LookupRow As Long
Dim StandClm As Integer
Dim InstInstClm As Integer
Dim VendInClm As Integer
Dim InstEnClm As Integer
Dim BareTuClm As Integer
Dim BareTubClm As Integer


On Error Resume Next
Lookup = Me.TextBox12.Value
LookupRow = Application.Match(Lookup, Range("C:C"), 0)

StandClm = 51
InstInClm = 52
VendInClm = 53
InstEnClm = 54
BareTuClm = 55
BareTubClm = 56
PreInsuClm = 57
PreInsulClm = 58
AirDropClm = 59
MiscPanClm = 60
InstBuiClm = 61
InstHooClm = 62

If Me.Stands <> "" Then Cells(LookupRow, StandClm) = Me.Stands
If Me.Instruments_Installed <> "" Then Cells(LookupRow, InstInClm) = Me.Instruments_Installed
If Me.Vendor_Instruments <> "" Then Cells(LookupRow, VendInClm) = Me.Vendor_Instruments
If Me.Instrument_Enclosures <> "" Then Cells(LookupRow, InstEnClm) = Me.Instrument_Enclosures
If Me.Bare_Tubing_Footage <> "" Then Cells(LookupRow, BareTuClm) = Me.Bare_Tubing_Footage
If Me.Bare_Tubing_Footage_Test <> "" Then Cells(LookupRow, BareTubClm) = Me.Bare_Tubing_Footage_Test
If Me.Pre_Insulated_Tubing <> "" Then Cells(LookupRow, PreInsuClm) = Me.Pre_Insulated_Tubing
If Me.Pre_Insulated_Tubing_Test <> "" Then Cells(LookupRow, PreInsulClm) = Me.Pre_Insulated_Tubing_Test
If Me.Air_Drops <> "" Then Cells(LookupRow, AirDropClm) = Me.Air_Drops
If Me.Misc_Panels <> "" Then Cells(LookupRow, MiscPanClm) = Me.Misc_Panels
If Me.Instrument_Buildings <> "" Then Cells(LookupRow, InstBuiClm) = Me.Instrument_Buildings
If Me.Instrument_Hook_Ups <> "" Then Cells(LookupRow, InstHooClm) = Me.Instrument_Hook_Ups





End Sub


Private Sub CommandButton2_Click()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButton"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
End Select
Next ctl

End Sub


Private Sub CommandButton3_Click()
Dim iExit As VbMsgBoxResult

iExit = MsgBox("Confirm if you want to exit", vbQuestion + vbYesNo, "Data Entry Form")

If iExit = vbYes Then
Unload Me
End If

End Sub
 
Sort by date Sort by votes
Pi_Lover said:
Yes sir, you are correct. The first sheet operates by using the value from one text box to look up against, and then drop the remaining data from the other text boxes in that specific row. And yes, to preserve the existing data when no value has been entered. For the second sheet I want all values dropped into the next available row, and, like you said, any text box that is blank needs to remain blank on the second sheet.

Yes again! To the second sheet data starting at Column A.
Click to expand...

Hi,
give following a try & see if does what you want

Make backup of your workbook & then delete all existing code in userform and replace with following

Rich (BB code): 
Option Base 1
Dim ControlsArr As Variant
Private Sub CommandButton1_Click()
    Dim Data()      As Variant, LookupRow  As Variant
    Dim Lookup      As Variant, SheetNames As Variant
    Dim Ctrl        As Control
    Dim c           As Long
    Dim sh          As Worksheet
    
    Const StandClm As Long = 51, InstHooClm As Long = 62
    
    Lookup = Me.TextBox12.Value
    If Len(Lookup) = 0 Then Exit Sub
    
    'change sheet names as required
    SheetNames = Array("Sheet1", "Sheet2")
    
    ReDim Data(1 To UBound(ControlsArr))
    
    On Error GoTo myerror
    For Each sh In ThisWorkbook.Worksheets(SheetNames)
        Select Case sh.Name
            Case SheetNames(1)
                LookupRow = Application.Match(Lookup, sh.Range("C:C"), 0)
                If IsError(LookupRow) Then Err.Raise 53
                
                For c = StandClm To InstHooClm
                    Set Ctrl = ControlsArr(c - 50)
                    'update cell only if value entered
                    If Ctrl <> "" Then sh.Cells(LookupRow, c).Value = Ctrl.Value
                    Data(c - 50) = Ctrl.Value
                    
                    'clear record (optional)
                    Ctrl.Value = ""
                    
                    Set Ctrl = Nothing
                Next c
                
            Case Else
                '2nd worksheet will only require the data to be dropped into the next available row
                LookupRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
                sh.Cells(LookupRow, 1).Resize(, UBound(Data)).Value = Data
        End Select
    Next sh
    
    MsgBox Lookup & Chr(10) & "Record Updated", 64, "Success"
    
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"

End Sub

Private Sub CommandButton2_Click()
    Dim Ctrl        As Variant
    'clear controls
    For Each Ctrl In ControlsArr
        Ctrl.Value = IIf(VarType(Ctrl) = vbBoolean, False, _
                     IIf(TypeName(Ctrl) = ListBox, -1, ""))
    Next Ctrl
End Sub

Private Sub UserForm_Initialize()
    ControlsArr = Array(Me.Stands, Me.Instruments_Installed, Me.Vendor_Instruments, Me.Instrument_Enclosures, _
                  Me.Bare_Tubing_Footage, Me.Bare_Tubing_Footage_Test, Me.Pre_Insulated_Tubing, _
                  Me.Pre_Insulated_Tubing_Test, Me.Air_Drops, Me.Misc_Panels, Me.Instrument_Buildings, _
                  Me.Instrument_Hook_Ups)
    
End Sub

Note the variable & option base 1 statement - these MUST be placed at very TOP of your userforms code page OUTSIDE any procedure

Dave
 
Upvote 1

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
dmt32 said:
Hi,
give following a try & see if does what you want

Make backup of your workbook & then delete all existing code in userform and replace with following

Rich (BB code): 
Option Base 1
Dim ControlsArr As Variant
Private Sub CommandButton1_Click()
    Dim Data()      As Variant, LookupRow  As Variant
    Dim Lookup      As Variant, SheetNames As Variant
    Dim Ctrl        As Control
    Dim c           As Long
    Dim sh          As Worksheet
   
    Const StandClm As Long = 51, InstHooClm As Long = 62
   
    Lookup = Me.TextBox12.Value
    If Len(Lookup) = 0 Then Exit Sub
   
    'change sheet names as required
    SheetNames = Array("Sheet1", "Sheet2")
   
    ReDim Data(1 To UBound(ControlsArr))
   
    On Error GoTo myerror
    For Each sh In ThisWorkbook.Worksheets(SheetNames)
        Select Case sh.Name
            Case SheetNames(1)
                LookupRow = Application.Match(Lookup, sh.Range("C:C"), 0)
                If IsError(LookupRow) Then Err.Raise 53
               
                For c = StandClm To InstHooClm
                    Set Ctrl = ControlsArr(c - 50)
                    'update cell only if value entered
                    If Ctrl <> "" Then sh.Cells(LookupRow, c).Value = Ctrl.Value
                    Data(c - 50) = Ctrl.Value
                   
                    'clear record (optional)
                    Ctrl.Value = ""
                   
                    Set Ctrl = Nothing
                Next c
               
            Case Else
                '2nd worksheet will only require the data to be dropped into the next available row
                LookupRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
                sh.Cells(LookupRow, 1).Resize(, UBound(Data)).Value = Data
        End Select
    Next sh
   
    MsgBox Lookup & Chr(10) & "Record Updated", 64, "Success"
   
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"

End Sub

Private Sub CommandButton2_Click()
    Dim Ctrl        As Variant
    'clear controls
    For Each Ctrl In ControlsArr
        Ctrl.Value = IIf(VarType(Ctrl) = vbBoolean, False, _
                     IIf(TypeName(Ctrl) = ListBox, -1, ""))
    Next Ctrl
End Sub

Private Sub UserForm_Initialize()
    ControlsArr = Array(Me.Stands, Me.Instruments_Installed, Me.Vendor_Instruments, Me.Instrument_Enclosures, _
                  Me.Bare_Tubing_Footage, Me.Bare_Tubing_Footage_Test, Me.Pre_Insulated_Tubing, _
                  Me.Pre_Insulated_Tubing_Test, Me.Air_Drops, Me.Misc_Panels, Me.Instrument_Buildings, _
                  Me.Instrument_Hook_Ups)
   
End Sub

Note the variable & option base 1 statement - these MUST be placed at very TOP of your userforms code page OUTSIDE any procedure

Dave
Click to expand...
Thank you, sir! I'll give this a try and let you know how it worked out
 
Upvote 0
dmt32 said:
Hi,
give following a try & see if does what you want

Make backup of your workbook & then delete all existing code in userform and replace with following

Rich (BB code): 
Option Base 1
Dim ControlsArr As Variant
Private Sub CommandButton1_Click()
    Dim Data()      As Variant, LookupRow  As Variant
    Dim Lookup      As Variant, SheetNames As Variant
    Dim Ctrl        As Control
    Dim c           As Long
    Dim sh          As Worksheet
   
    Const StandClm As Long = 51, InstHooClm As Long = 62
   
    Lookup = Me.TextBox12.Value
    If Len(Lookup) = 0 Then Exit Sub
   
    'change sheet names as required
    SheetNames = Array("Sheet1", "Sheet2")
   
    ReDim Data(1 To UBound(ControlsArr))
   
    On Error GoTo myerror
    For Each sh In ThisWorkbook.Worksheets(SheetNames)
        Select Case sh.Name
            Case SheetNames(1)
                LookupRow = Application.Match(Lookup, sh.Range("C:C"), 0)
                If IsError(LookupRow) Then Err.Raise 53
               
                For c = StandClm To InstHooClm
                    Set Ctrl = ControlsArr(c - 50)
                    'update cell only if value entered
                    If Ctrl <> "" Then sh.Cells(LookupRow, c).Value = Ctrl.Value
                    Data(c - 50) = Ctrl.Value
                   
                    'clear record (optional)
                    Ctrl.Value = ""
                   
                    Set Ctrl = Nothing
                Next c
               
            Case Else
                '2nd worksheet will only require the data to be dropped into the next available row
                LookupRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
                sh.Cells(LookupRow, 1).Resize(, UBound(Data)).Value = Data
        End Select
    Next sh
   
    MsgBox Lookup & Chr(10) & "Record Updated", 64, "Success"
   
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"

End Sub

Private Sub CommandButton2_Click()
    Dim Ctrl        As Variant
    'clear controls
    For Each Ctrl In ControlsArr
        Ctrl.Value = IIf(VarType(Ctrl) = vbBoolean, False, _
                     IIf(TypeName(Ctrl) = ListBox, -1, ""))
    Next Ctrl
End Sub

Private Sub UserForm_Initialize()
    ControlsArr = Array(Me.Stands, Me.Instruments_Installed, Me.Vendor_Instruments, Me.Instrument_Enclosures, _
                  Me.Bare_Tubing_Footage, Me.Bare_Tubing_Footage_Test, Me.Pre_Insulated_Tubing, _
                  Me.Pre_Insulated_Tubing_Test, Me.Air_Drops, Me.Misc_Panels, Me.Instrument_Buildings, _
                  Me.Instrument_Hook_Ups)
   
End Sub

Note the variable & option base 1 statement - these MUST be placed at very TOP of your userforms code page OUTSIDE any procedure

Dave
Click to expand...
This works great! Thank you. There is one issue, and it's my fault for not communicating it. I also want the text box value dropped into the second sheet (The same value we used to lookup in the first sheet to determine where to drop the data), and also another textbox that was not used for the first sheet at all. See attached pics below for reference. The two missing on the second sheet will be "Foreman Name" and "Instrument Tag#". I apologize for not communicating that earlier.

Data Entery Form.png
Qtrax.png
 
Upvote 0
Pi_Lover said:
The two missing on the second sheet will be "Foreman Name" and "Instrument Tag#". I apologize for not communicating that earlier.
Click to expand...

Always helpful if you fully explain your requirement from outset

your picture of sheet2 just shows a Field for Foreman Name in Column A - Which Column does Instrument Tag post to?
Can you also confirm the names of these two controls.

For future, please use MrExcel Addin XL2BB to post a copy of your worksheet.

Dave
 
Upvote 0
dmt32 said:
Always helpful if you fully explain your requirement from outset

your picture of sheet2 just shows a Field for Foreman Name in Column A - Which Column does Instrument Tag post to?
Can you also confirm the names of these two controls.

For future, please use MrExcel Addin XL2BB to post a copy of your worksheet.

Dave
Click to expand...
Yeah, my bad bro

That will be put into Col. B once I insert

Will do
 
Upvote 0
Hi
replace existing codes with following & see if updates do what you want

VBA Code: 
Option Base 1
Dim ControlsArr As Variant
Private Sub CommandButton1_Click()
    Dim Data()      As Variant, LookupRow  As Variant
    Dim Lookup      As Variant, SheetNames As Variant
    Dim ForemanName As String
    Dim Ctrl        As Control
    Dim c           As Long
    Dim sh          As Worksheet
   
    Const StandClm As Long = 51, InstHooClm As Long = 62
   
    On Error GoTo myerror
   
    Lookup = ControlsArr(2)
    If Len(Lookup) = 0 Then Exit Sub
    ForemanName = ControlsArr(1)
    'name entry required (comment out if not required)
    If Len(ForemanName) = 0 Then ControlsArr(1).SetFocus: Err.Raise 600, , "Entry Required"
   
    'change sheet names as required
    SheetNames = Array("Sheet1", "Sheet2")
   
    ReDim Data(1 To UBound(ControlsArr))
   
    For Each sh In ThisWorkbook.Worksheets(SheetNames)
        Select Case sh.Name
            Case SheetNames(1)
                LookupRow = Application.Match(Lookup, sh.Range("C:C"), 0)
                If IsError(LookupRow) Then Err.Raise 53
               
                For c = StandClm To InstHooClm
                    Set Ctrl = ControlsArr(c - 48)
                    'update cell only if value entered
                    If Ctrl <> "" Then sh.Cells(LookupRow, c).Value = Ctrl.Value
                    Data(c - 48) = Ctrl.Value
                   
                    Set Ctrl = Nothing
                Next c
               
            Case Else
                Data(1) = ForemanName: Data(2) = Lookup
                '2nd worksheet will only require the data to be dropped into the next available row
                LookupRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
                sh.Cells(LookupRow, 1).Resize(, UBound(Data)).Value = Data
        End Select
    Next sh
   
    'clear record (optional)
    Call CommandButton2_Click
   
    MsgBox Lookup & Chr(10) & "Record Updated", 64, "Success"
   
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"

End Sub

Private Sub CommandButton2_Click()
    Dim Ctrl        As Variant
    'clear controls
    For Each Ctrl In ControlsArr
        Ctrl.Value = IIf(VarType(Ctrl) = vbBoolean, False, _
                     IIf(TypeName(Ctrl) = ListBox, -1, ""))
    Next Ctrl
    ControlsArr(2).SetFocus
End Sub

Private Sub UserForm_Initialize()
    ControlsArr = Array(Me.Foreman_Name, Me.Inst_Tag, Me.Stands, Me.Instruments_Installed, _
                        Me.Vendor_Instruments, Me.Instrument_Enclosures, Me.Bare_Tubing_Footage, Me.Bare_Tubing_Footage_Test, _
                        Me.Pre_Insulated_Tubing, Me.Pre_Insulated_Tubing_Test, Me.Air_Drops, Me.Misc_Panels, _
                        Me.Instrument_Buildings, Me.Instrument_Hook_Ups)
   
End Sub
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,224,813
Messages
6,181,112
Members
453,021
Latest member
Justyna P

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