VBA code for userform , to add data to specific cells based on combolistbox selection

S

sloany101

New Member
Joined
Jan 7, 2023
Messages
35
Office Version
  1. 365
Good evening, i have searched far and wide across this site and have come across a few that have helped but nothing i am able to manipulate to my needs , i have a userform that pulls up a window to input data into a Room/Bunk assignment spreadsheet,

the information that is to be put in the spread sheet is as follows : Name , Response team (yes/no) , SSE (yes/no) , Lifeboat (1/2) , Galley (yes/no) , there is an additional drop down box labeled Room/Bunk (1-62) **note the room/bunk combobox is the determining location for each of the others to be entered

A little information on this , it is a POB (personnel on board) sheet with rooms and specific bunks numbered 1-62

#'s 1-50 are rows A3-A52
#'s 51-62 are rows L3-L14

now
the name cells are in columns C3-C52 and M3-M14
Response team cells are in columns B3-B52 only
SSE cells are in columns H3-H52 & R3-R14
Lifeboat cells are in columns G3-G52 & Q3-Q14
Galley cells are in columns I3-I52 & S3-S14

what i need is for when i click a activex button to "add to POB" it will input name, response team, sse, lifeboat, galley data into specified cells based on the room/bunk selection
for example : if # 6 is selected then personnel name will be placed in cell C8 , response team will be placed in B8 , SSE will be placed in H8 , Lifeboat will be placed in G8 , Galley will be placed in I8 etc etc

i have the user form built already just need to make the activex button perform this action

here are the names for each combobox / textbox

Name = pobNAME
Room/Bunk = txtRMBK
Response Team = txtRT
SSE = txtSSE1
Lifeboat = txtLB
Galley = txtGAL

Below is the current code i have for the user form


VBA Code: 
Private Sub addPOB_Click()

End Sub

Private Sub Userform_Initialize()
With Me.txtRMBK
    .Clear
    .AddItem "1"
    .AddItem "2"
    .AddItem "3"
    .AddItem "4"
    .AddItem "5"
    .AddItem "6"
    .AddItem "7"
    .AddItem "8"
    .AddItem "9"
    .AddItem "10"
    .AddItem "11"
    .AddItem "12"
    .AddItem "13"
    .AddItem "14"
    .AddItem "15"
    .AddItem "16"
    .AddItem "17"
    .AddItem "18"
    .AddItem "19"
    .AddItem "20"
    .AddItem "21"
    .AddItem "22"
    .AddItem "23"
    .AddItem "24"
    .AddItem "25"
    .AddItem "26"
    .AddItem "27"
    .AddItem "28"
    .AddItem "29"
    .AddItem "30"
    .AddItem "31"
    .AddItem "32"
    .AddItem "33"
    .AddItem "34"
    .AddItem "35"
    .AddItem "36"
    .AddItem "37"
    .AddItem "38"
    .AddItem "39"
    .AddItem "40"
    .AddItem "41"
    .AddItem "42"
    .AddItem "43"
    .AddItem "44"
    .AddItem "45"
    .AddItem "46"
    .AddItem "47"
    .AddItem "48"
    .AddItem "49"
    .AddItem "50"
    .AddItem "51"
    .AddItem "52"
    .AddItem "53"
    .AddItem "54"
    .AddItem "55"
    .AddItem "56"
    .AddItem "57"
    .AddItem "58"
    .AddItem "59"
    .AddItem "60"
    .AddItem "61"
    .AddItem "62"
End With
With Me.txtRT
    .Clear
    .AddItem "Yes"
    .AddItem "No"
End With
With Me.txtSSE1
    .Clear
    .AddItem "Yes"
    .AddItem "No"
End With
With Me.txtLB
    .Clear
    .AddItem "1"
    .AddItem "2"
End With
With Me.txtGAL
    .Clear
    .AddItem "Yes"
    .AddItem "No"
End With
End Sub
Screenshot (5).png


Above is a image of what the userform menu will look like , if any additional information is needed i will do my best to provide it , thanks for any help.
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
sloany101 said:
Below is the current code i have for the user form
Click to expand...

I've simplified your code a bit, just so you know other ways to load the data into the listbox:
VBA Code: 
Private Sub Userform_Initialize()
  Me.txtRMBK.List = [row(1:62)]
  With Me.txtRT
    .AddItem "Yes"
    .AddItem "No"
  End With
  With Me.txtSSE1
    .AddItem "Yes"
    .AddItem "No"
  End With
  With Me.txtLB
    .AddItem "1"
    .AddItem "2"
  End With
  With Me.txtGAL
    .AddItem "Yes"
    .AddItem "No"
  End With
End Sub

sloany101 said:
what i need is for when i click a activex button to "add to POB" it will input name, response team, sse, lifeboat, galley data into specified cells based on the room/bunk selection
Click to expand...
Here is the code to put the data in the sheet.
Just update the sheet name "Sheet1" with the name of your sheet in this line of the macro:
Rich (BB code): 
With Sheets("Sheet1")

I added a validations section, since the txtRMBK, at the very least, should be required.

Try this:
VBA Code: 
Private Sub CommandButton1_Click()
  Dim n As Long, m As Long
 
  'validations (for example)
  If pobNAME.Value = "" Then
    MsgBox "Enter name"
    pobNAME.SetFocus
    Exit Sub
  End If
  If txtRMBK.Value = "" Or txtRMBK.ListIndex = -1 Then
    MsgBox "Enter Room/Bunk"
    txtRMBK.SetFocus
    Exit Sub
  End If
  'continue with other validations if you want...
 
  n = txtRMBK.Value + 2
  If txtRMBK.Value > 50 Then
    n = n - 50
    m = 11
  End If
 
  With Sheets("Sheet1") 'fit to the name of your sheet
    .Cells(n, 2 + m).Value = txtRT.Value
    .Cells(n, 3 + m).Value = pobNAME.Value
    .Cells(n, 7 + m).Value = txtSSE1.Value
    .Cells(n, 8 + m).Value = txtLB.Value
    .Cells(n, 9 + m).Value = txtGAL.Value
  End With
End Sub
 
Upvote 0
DanteAmor said:
I've simplified your code a bit, just so you know other ways to load the data into the listbox:
VBA Code: 
Private Sub Userform_Initialize()
  Me.txtRMBK.List = [row(1:62)]
  With Me.txtRT
    .AddItem "Yes"
    .AddItem "No"
  End With
  With Me.txtSSE1
    .AddItem "Yes"
    .AddItem "No"
  End With
  With Me.txtLB
    .AddItem "1"
    .AddItem "2"
  End With
  With Me.txtGAL
    .AddItem "Yes"
    .AddItem "No"
  End With
End Sub


Here is the code to put the data in the sheet.
Just update the sheet name "Sheet1" with the name of your sheet in this line of the macro:
Rich (BB code): 
With Sheets("Sheet1")

I added a validations section, since the txtRMBK, at the very least, should be required.

Try this:
VBA Code: 
Private Sub CommandButton1_Click()
  Dim n As Long, m As Long
 
  'validations (for example)
  If pobNAME.Value = "" Then
    MsgBox "Enter name"
    pobNAME.SetFocus
    Exit Sub
  End If
  If txtRMBK.Value = "" Or txtRMBK.ListIndex = -1 Then
    MsgBox "Enter Room/Bunk"
    txtRMBK.SetFocus
    Exit Sub
  End If
  'continue with other validations if you want...
 
  n = txtRMBK.Value + 2
  If txtRMBK.Value > 50 Then
    n = n - 50
    m = 11
  End If
 
  With Sheets("Sheet1") 'fit to the name of your sheet
    .Cells(n, 2 + m).Value = txtRT.Value
    .Cells(n, 3 + m).Value = pobNAME.Value
    .Cells(n, 7 + m).Value = txtSSE1.Value
    .Cells(n, 8 + m).Value = txtLB.Value
    .Cells(n, 9 + m).Value = txtGAL.Value
  End With
End Sub
Click to expand...
this worked great , had to tweak it a bit , #'s 51-62 were inputting off by one cell had to change the 11 to 10 , but other than that it works fine , i added some additional things i wanted the sequence to do and it is working great except one thing , #'s 51-62 do not have a RT column only #'s 1-50 , and it is deleting the #'s 51-62 cells when i leave the RT portion of the userform blank , is there a way to make it skip the response team portion , i have hit a wall on this.
 
Upvote 1
sloany101 said:
except one thing , #'s 51-62 do not have a RT column only #'s 1-50
Click to expand...
Sorry, I forgot that part.
Change this line:
VBA Code: 
.Cells(n, 3 + m).Value = pobNAME.Value


For this:
VBA Code: 
If txtRMBK.Value < 51 Then .Cells(n, 3 + m).Value = pobNAME.Value
 
Upvote 0
DanteAmor said:
Sorry, I forgot that part.
Change this line:
VBA Code: 
.Cells(n, 3 + m).Value = pobNAME.Value


For this:
VBA Code: 
If txtRMBK.Value < 51 Then .Cells(n, 3 + m).Value = pobNAME.Value
Click to expand...
its not working , still doing the same as before , where it is trying to put the RT data for #'s 51-62 is where the actual #'s 51-62 are , i will post the code i have below , i changed the yes/no's to a check mark as that is what i have used to designate for a "Yes" and if its no the cells are just left blank , but it is erasing the # and putting a blank .
VBA Code: 
Private Sub addPOB_Click()
Dim n As Long, m As Long
Application.ScreenUpdating = False
 Application.EnableEvents = False
  'validations (for example)
  If pobNAME.Value = "" Then
    MsgBox "Enter name"
    pobNAME.SetFocus
    Exit Sub
  End If
  If txtRMBK.Value = "" Or txtRMBK.ListIndex = -1 Then
    MsgBox "Enter Room/Bunk"
    txtRMBK.SetFocus
    Exit Sub
  End If
 
 
  'continue with other validations if you want...
 
  n = txtRMBK.Value + 2
  If txtRMBK.Value > 50 Then
    n = n - 50
    m = 10
  End If
 
  With Sheets("Daily POB") 'fit to the name of your sheet
    .Cells(n, 2 + m).Value = txtRT.Value
    If txtRMBK.Value < 51 Then .Cells(n, 3 + m).Value = pobNAME.Value
    .Cells(n, 8 + m).Value = txtSSE1.Value
    .Cells(n, 7 + m).Value = txtLB.Value
    .Cells(n, 9 + m).Value = txtGAL.Value
  End With
 
Me.txtRT.Value = ""
Me.pobNAME.Value = ""
Me.txtSSE1.Value = ""
Me.txtLB.Value = ""
Me.txtGAL.Value = ""
Me.txtRMBK.Value = ""

ActiveCell.Select
 
Call loaddic
Call loaddicbag
Call loaddicbdy
Call loaddicWBS
Call test
Call testbag
Call testbdy
Call testWBS

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Private Sub Userform_Initialize()
  Me.txtRMBK.List = [row(1:62)]
  With Me.txtRT
    .Clear
    .AddItem ChrW(&H2713)
  End With
  With Me.txtSSE1
    .Clear
    .AddItem ChrW(&H2713)
  End With
  With Me.txtLB
    .Clear
    .AddItem "1"
    .AddItem "2"
  End With
  With Me.txtGAL
    .Clear
    .AddItem ChrW(&H2713)
  End With
End Sub
 
Upvote 0
sloany101 said:
the name cells are in columns C3-C52 and M3-M14
Response team cells are in columns B3-B52 only
SSE cells are in columns H3-H52 & R3-R14
Lifeboat cells are in columns G3-G52 & Q3-Q14
Galley cells are in columns I3-I52 & S3-S14
Click to expand...
Based on the above, try this:

VBA Code: 
Private Sub CommandButton1_Click()
  Dim n As Long
  
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  
  'validations (for example)
  If pobNAME.Value = "" Then
    MsgBox "Enter name"
    pobNAME.SetFocus
    Exit Sub
  End If
  If txtRMBK.Value = "" Or txtRMBK.ListIndex = -1 Then
    MsgBox "Enter Room/Bunk"
    txtRMBK.SetFocus
    Exit Sub
  End If
  'continue with other validations if you want...
  
  With Sheets("Daily POB") 'fit to the name of your sheet
    If txtRMBK.Value < 51 Then
      n = txtRMBK.Value + 2
      .Cells(n, "B").Value = txtRT.Value
      .Cells(n, "C").Value = pobNAME.Value
      .Cells(n, "H").Value = txtSSE1.Value
      .Cells(n, "G").Value = txtLB.Value
      .Cells(n, "I").Value = txtGAL.Value
    Else
      n = txtRMBK.Value - 48
      .Cells(n, "M").Value = pobNAME.Value
      .Cells(n, "R").Value = txtSSE1.Value
      .Cells(n, "Q").Value = txtLB.Value
      .Cells(n, "S").Value = txtGAL.Value
    End If
  End With
  
  Me.txtRT.Value = ""
  Me.pobNAME.Value = ""
  Me.txtSSE1.Value = ""
  Me.txtLB.Value = ""
  Me.txtGAL.Value = ""
  Me.txtRMBK.Value = ""
  
  ActiveCell.Select
   
  Call loaddic
  Call loaddicbag
  Call loaddicbdy
  Call loaddicWBS
  Call test
  Call testbag
  Call testbdy
  Call testWBS
  
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

Private Sub Userform_Initialize()
  txtRMBK.List = [row(1:62)]
  txtRT.AddItem ChrW(&H2713)
  txtSSE1.AddItem ChrW(&H2713)
  
  txtLB.AddItem "1"
  txtLB.AddItem "2"
  
  txtGAL.AddItem ChrW(&H2713)
End Sub
 
Upvote 0
Solution
DanteAmor said:
Based on the above, try this:

VBA Code: 
Private Sub CommandButton1_Click()
  Dim n As Long
 
  Application.ScreenUpdating = False
  Application.EnableEvents = False
 
  'validations (for example)
  If pobNAME.Value = "" Then
    MsgBox "Enter name"
    pobNAME.SetFocus
    Exit Sub
  End If
  If txtRMBK.Value = "" Or txtRMBK.ListIndex = -1 Then
    MsgBox "Enter Room/Bunk"
    txtRMBK.SetFocus
    Exit Sub
  End If
  'continue with other validations if you want...
 
  With Sheets("Daily POB") 'fit to the name of your sheet
    If txtRMBK.Value < 51 Then
      n = txtRMBK.Value + 2
      .Cells(n, "B").Value = txtRT.Value
      .Cells(n, "C").Value = pobNAME.Value
      .Cells(n, "H").Value = txtSSE1.Value
      .Cells(n, "G").Value = txtLB.Value
      .Cells(n, "I").Value = txtGAL.Value
    Else
      n = txtRMBK.Value - 48
      .Cells(n, "M").Value = pobNAME.Value
      .Cells(n, "R").Value = txtSSE1.Value
      .Cells(n, "Q").Value = txtLB.Value
      .Cells(n, "S").Value = txtGAL.Value
    End If
  End With
 
  Me.txtRT.Value = ""
  Me.pobNAME.Value = ""
  Me.txtSSE1.Value = ""
  Me.txtLB.Value = ""
  Me.txtGAL.Value = ""
  Me.txtRMBK.Value = ""
 
  ActiveCell.Select
  
  Call loaddic
  Call loaddicbag
  Call loaddicbdy
  Call loaddicWBS
  Call test
  Call testbag
  Call testbdy
  Call testWBS
 
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

Private Sub Userform_Initialize()
  txtRMBK.List = [row(1:62)]
  txtRT.AddItem ChrW(&H2713)
  txtSSE1.AddItem ChrW(&H2713)
 
  txtLB.AddItem "1"
  txtLB.AddItem "2"
 
  txtGAL.AddItem ChrW(&H2713)
End Sub
Click to expand...
HELL YES, that worked EXACTLY perfect , thanks PAL i appreciate it.
 
Upvote 0
You must log in or register to reply here.

Similar threads

SkywardPalm
  • Question Question
Populate blank cells based on column values from multiple sheets, using Item Number and column headers
Replies
1
Views
809
SkywardPalm
SkywardPalm
T
  • Question Question
VBA to launch userform by selecting a cell
2
Replies
10
Views
2K
Logit
Logit
T
  • Solved
Data selection -- Final Outcome and Automatic fill in of specific Cells based on Data selected
Replies
8
Views
1K
maabadi
M
G
  • Solved
VBA Code to compare single column date on worksheet with 2 column start and end dates, copy select information horizontally, to empty cells.
Replies
4
Views
936
GAdams106
G
S
  • Question Question
VBA code to automatically send several different emails (body different) based on cell data
Replies
0
Views
1K
Schanemans
S

Forum statistics

Threads
1,224,823
Messages
6,181,175
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