How to add multiple values into one single cell - vba

Private Sub CommandButton1_Click()
Dim ctrl As control
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
'Pass this CheckBox to the subroutine below:
TransferValues ctrl
End If
Next
End Sub
Sub TransferValues(cb As MSForms.CheckBox)
Dim ws As Worksheet
Dim emptyRow As Long
Dim ws1 As Worksheet
If cb Then
'Define the worksheet based on the CheckBox.Name property:
Set ws = Sheets(Left(cb.Name, 15))
emptyRow = WorksheetFunction.CountA(ws.range("A:A")) + 1
With ws
.Cells(emptyRow, 1).Value = surname.Value
.Cells(emptyRow, 2).Value = firstname.Value
.Cells(emptyRow, 3).Value = tod.Value
.Cells(emptyRow, 4).Value = program.Value
.Cells(emptyRow, 5).Value = email.Value
.Cells(emptyRow, 6).Value = officenumber.Value
.Cells(emptyRow, 7).Value = cellnumber.Value
End With
Set ws1 = Sheets("Master")
emptyRow = WorksheetFunction.CountA(range("A:A")) + 1
With ws1
.Cells(emptyRow, 1).Value = surname.Value
.Cells(emptyRow, 2).Value = firstname.Value
.Cells(emptyRow, 3).Value = tod.Value
.Cells(emptyRow, 4).Value = program.Value
.Cells(emptyRow, 5).Value = email.Value
.Cells(emptyRow, 6).Value = officenumber.Value
.Cells(emptyRow, 7).Value = cellnumber.Value
.Cells(emptyRow, 8).Value = cb.Name
End With
End If
'the master sheet needs to have a "Stakeholder" column with list of stakeholder the person belongs to
The problem here is Cb.Name - I want the name checkboxes to appear in one single cell but right now it's making extra rows depending on the number of checked boxes. So instead of putting 6/8 checked boxes names into 1 single cell it makes 6 rows with each names which is not good. How do i transfer all cb.names into one single cell?
sorry if the code doesn't look properly formatted - for some reason it's not showing all the indents...

If I read you right your transfer function deals with individual checks but the master sheet needs to have a single line for the whole lot, right?
If so what you will need to do is work on the individual and collective levels separately. Delete all references to the master sheet from your basic sub and deal with the master sheet on it's own
Sub TransferMasterValue()
Dim allChecks As String
'Iterate through the checkboxes concatenating a string of all names
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl Then
allChecks = allChecks & ctrl.Name & ","
End If
End If
Next
'If you have at least one transfer to the Master sheet
If Len(allChecks) > 0 Then
'Your code to transfer
Set ws1 = Sheets("Master")
emptyRow = WorksheetFunction.CountA(range("A:A")) + 1
With ws1
.Cells(emptyRow, 1).Value = surname.Value
...
'and post the concatenated value in the name position
.Cells(emptyRow, 8).Value = left(allChecks,len(allChecks)-1)
End With
End If
End Sub
The main button click function will then look like...
Private Sub CommandButton1_Click()
Dim ctrl As control
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
'Pass this CheckBox to the subroutine below:
TransferValues ctrl
End If
Next
TransferMasterValue
End Sub

Have you tried concatenate? If I have cells |1|2|3|4|5| I can just insert the function =CONCATENATE(A1,",",B1) and you can change to "," to " " for a space, or have no separation at all. If this isn't what you're looking for then I think I misinterpted the question.

Related

Having trouble using designer and inputng VBA Code

Can someone help me get my userform to submit into this table from cal worksheet?
Private Sub cmdbutton_submitform_Click()
Dim emptyRow As Long
'Make Sheet2 active
Sheet2.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information
Cells(emptyRow, 1).Value = txtbox_number.Value
Cells(emptyRow, 2).Value = txtbox_rank.Value
Cells(emptyRow, 3).Value = txtbox_Name.Value
Cells(emptyRow, 4).Value = txtbox_height.Value
Cells(emptyRow, 5).Value = txtbox_weight.Value
Cells(emptyRow, 6).Value = txtbox_right_rm.Value
Cells(emptyRow, 7).Value = txtbox_left_rm.Value
End Sub
I think you are getting confused with sheet codenames and sheet names (see this). Try
Private Sub cmdbutton_submitform_Click()
Dim emptyRow As Long
With Worksheets("Sheet2")
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(.Range("A:A")) + 1
'Transfer information
.Cells(emptyRow, 1).Value = txtbox_number.Value
.Cells(emptyRow, 2).Value = txtbox_rank.Value
.Cells(emptyRow, 3).Value = txtbox_Name.Value
.Cells(emptyRow, 4).Value = txtbox_height.Value
.Cells(emptyRow, 5).Value = txtbox_weight.Value
.Cells(emptyRow, 6).Value = txtbox_right_rm.Value
.Cells(emptyRow, 7).Value = txtbox_left_rm.Value
End With
End Sub
Using Worksheet.Activate method likely loses the parent form reference that is required to correctly get the text box data from the user form. Within this Private Sub you should be able to reference Sheet2 by its Worksheet .CodeName property and use Me to reference the user form as the parent of the text boxes.
Private Sub cmdbutton_submitform_Click()
Dim emptyRow As Long
'Reference Sheet2 by CodeName as the parent worksheet of the .Cells
With Sheet2
'Determine emptyRow
emptyRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
'Transfer information
.Cells(emptyRow, 1).Value = Me.txtbox_number.Value
.Cells(emptyRow, 2).Value = Me.txtbox_rank.Value
.Cells(emptyRow, 3).Value = Me.txtbox_Name.Value
.Cells(emptyRow, 4).Value = Me.txtbox_height.Value
.Cells(emptyRow, 5).Value = Me.txtbox_weight.Value
.Cells(emptyRow, 6).Value = Me.txtbox_right_rm.Value
.Cells(emptyRow, 7).Value = Me.txtbox_left_rm.Value
End With
End Sub
I found it a little odd that you were identifying the worksheet with a Worksheet .CodeName property rather than a Worksheet .Name property. I've included a couple of links to make sure you are using the naming conventions correctly. In any event, I've use a With ... End With statement to avoid repeatedly reidentifying the parent worksheet.

Macro is only printing in active worksheet opposed to the referenced sheet

I wrote a VBA Macro that tries to take values input from text boxes in a user form and copies them into cells on a specific worksheet. I also wrote a countA function that allows me to write to a new row every time I hit the input button. For a reason that I cannot understand, it will only write to the active worksheet no matter what sheet I reference. Please Help!
Private Sub inputlight_Click()
Dim emptyrow As Long
'Find the first empty row after row 47 on sheet "T5 Input Sheet"
emptyrow = 47 + WorksheetFunction.CountA(Sheets("T5 Input Sheet").Range("b48:b219")) + 1
'transfer data
Cells(emptyrow, 2).Value = esize.Value
Cells(emptyrow, 3).Value = etype.Value
Cells(emptyrow, 4).Value = ewatt.Value
Cells(emptyrow, 5).Value = elamps.Value
Cells(emptyrow, 6).Value = eusage.Value
Cells(emptyrow, 7).Value = efixtures.Value
End Sub
I've tried changing it to CountA(Worksheets("T5 Input Sheet"), (Sheets(2)), (Sheets("Sheet2") etc. but none of them print to anything but the active cell. What am I doing wrong?
You take the correct approach using the CountA function however you also need to qualify your cells in order to stick values to a specific sheet.
Private Sub inputlight_Click()
Dim emptyrow As Long
'Find the first empty row after row 47 on sheet "T5 Input Sheet"
emptyrow = 47 + WorksheetFunction.CountA(Sheets("T5 Input Sheet").Range("b48:b219")) + 1
'transfer data
With Sheets("SHEET_NAME")
.Cells(emptyrow, 2).Value = esize.Value
.Cells(emptyrow, 3).Value = etype.Value
.Cells(emptyrow, 4).Value = ewatt.Value
.Cells(emptyrow, 5).Value = elamps.Value
.Cells(emptyrow, 6).Value = eusage.Value
.Cells(emptyrow, 7).Value = efixtures.Value
End With
End Sub
So where it says SHEET_NAME that's where you stick the destination Sheet name.

invalid procedure call or argument excel vba

i want have an add command and a search command. i thought if i reciprocate the add command then i can use it as a search command but it gives an invalid procedure call or argument.
add command:
Sub TransferMasterValue()
Dim allchecks As String
Dim ws As Worksheet
'Iterate through the checkboxes concatenating a string of all names
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl Then
allchecks = allchecks & ctrl.Name & " "
End If
End If
Next
'If you have at least one transfer to the Master sheet
If Len(allchecks) > 0 Then
Set ws1 = Sheets("Master")
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
With ws1
.Cells(emptyRow, 1).Value = surname.Value
.Cells(emptyRow, 2).Value = firstname.Value
.Cells(emptyRow, 3).Value = tod.Value
.Cells(emptyRow, 4).Value = program.Value
.Cells(emptyRow, 5).Value = email.Value
.Cells(emptyRow, 7).Value = officenumber.Value
.Cells(emptyRow, 8).Value = cellnumber.Value
.Cells(emptyRow, 6).Value = Left(allchecks, Len(allchecks) - 1)
End With
End If
End Sub
Search Command:
Private Sub Search_Click()
Dim Name As String
Dim f As Range
Dim r As Long
Dim ws As Worksheet
Dim s As Integer
Dim FirstAddress As String
Dim ctrl As control
Dim allchecks As String
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl.value = true Then
allchecks = allchecks & ctrl.Name & " "
End If
End If
Next
Name = surname.Value
With ws
Set f = Range("A:A").Find(what:=Name, LookIn:=xlValues)
If Not f Is Nothing Then
With Me
firstname.Value = f.Offset(0, 1).Value
tod.Value = f.Offset(0, 2).Value
program.Value = f.Offset(0, 3).Value
email.Value = f.Offset(0, 4).Text
officenumber.Value = f.Offset(0, 6).Text
cellnumber.Value = f.Offset(0, 7).Text
EDIT:
If Len(allchekcs)>0 then
If f.Offset(0, 5).Value = Left(allchecks, Len(allchecks) - 1) Then ctrl.Value = True
end if
EDIT: so i've added the if Len(allchecks)>0 then command, and it doesn't give error 5 but it still doesn't checkmark the userform checkboxes - how can i fix this? right now when the information is added to column 6, it's added as "Montreal Ottawa Toronto Vancouver" and perhaps that's why it's not picking it up? because there's multiple checkbox names in one cell? in order for ctrl.value = true to work the cell value has to equal to one ctrl.name? is there a way i can separate so it picks up using ctrl?
To separate the values in the cell, use the Split command:
For each ctrl in UserForm1.Controls
For i = 0 to UBound(Split(CellValue," "))
If Split(CellValue, " ")(i) = ctrl.Name Then ctrl.Value = True
Next i
Next
Where CellValue is the Value of the cell that contains the allchecks value.

How to add information from vba to multiple sheets

Private Sub CommandButton1_Click()
Dim ctrl As control
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
'Pass this CheckBox to the subroutine below:
TransferValues ctrl
End If
Next
End Sub
Sub TransferValues(cb As MSForms.CheckBox)
Dim ws As Worksheet
Dim emptyRow As Long
Dim ws1 As Worksheet
If cb Then
'Define the worksheet based on the CheckBox.Name property:
Set ws = Sheets(Left(cb.Name, 15))
emptyRow = WorksheetFunction.CountA(ws.range("A:A")) + 1
With ws
.Cells(emptyRow, 1).Value = surname.Value
.Cells(emptyRow, 2).Value = firstname.Value
.Cells(emptyRow, 3).Value = tod.Value
.Cells(emptyRow, 4).Value = program.Value
.Cells(emptyRow, 5).Value = email.Value
.Cells(emptyRow, 6).Value = officenumber.Value
.Cells(emptyRow, 7).Value = cellnumber.Value
End With
End If
'the master sheet needs to have a "Stakeholder" column with list of stakeholder the person belongs to
End Sub
Depending on which checkboxes are chekced, I want to compile the values of checkboxes into one cell in Master Tab and Master Tab only. Above code transfers the values of each textbox according to which stakeholder the person belongs to (and this is done through checkboxes)
For example, a person named John Doe belongs to 6/8 checkboxes, above code transfers all information to 6/8 checkboxed sheets. but i always want the information to be filled in the master tab with an additional column name stakeholder that'll transfer the names of the checked boxes. when i tried it, it made a seperate row for every checkboxes instead of compiling it into one cell. so i made 6 John Doe's with same information except each John Doe's had different stakeholder he belonged to.
We will do this using VBA and the below procedure illustrates how this was done.
Sub copyPasteData() Dim strSourceSheet As String Dim strDestinationSheet As String Dim lastRow As Long
strSourceSheet = "Data entry"
Sheets(strSourceSheet).Visible = True Sheets(strSourceSheet).Select
Range("C2").Select Do While ActiveCell.Value <> "" strDestinationSheet
= ActiveCell.Value ActiveCell.Offset(0, -2).Resize(1, ActiveCell.CurrentRegion.Columns.Count).Select Selection.Copy Sheets(strDestinationSheet).Visible = True Sheets(strDestinationSheet).Select lastRow = LastRowInOneColumn("A") Cells(lastRow + 1, 1).Select Selection.PasteSpecial xlPasteValues Application.CutCopyMode = False Sheets(strSourceSheet).Select ActiveCell.Offset(0, 2).Select ActiveCell.Offset(1, 0).Select Loop End Sub

Automatically check checkboxes when .Search vba in userform?

So I have the following code below: and what i want to focus on is the Private Sub Search_Click(). Currently when I search someone's surname it populate the textboxes automatically. Is it possible to have a search box that populates the checkboxes automatically? so for example, if the person belongs to 6/8 checkboxes, and i click search 6/8 checkboxes would be checkmarked? and is it possible to do the same thing with ListBox1_Click()? so when i click on person's name from listbox, it also popoulates the checkbocxes automatically depending on which checkbox that person belongs to?
EDIT
Private Sub Search_Click() 'only searches in master tab right now need to search from all worksheets
Dim Name As String
Dim f As Range
Dim r As Long
Dim ws As Worksheet
Dim s As Integer
Dim FirstAddress As String
Name = surname.Value
For Each ws In ActiveWorkbook.Sheets
With ws
Set f = Range("A:A").Find(what:=Name, LookIn:=xlValues)
If Not f Is Nothing Then
If cb.Name = ws.Name Then
cb.Value = True
End If
Next
With Me
firstname.Value = f.Offset(0, 1).Value
tod.Value = f.Offset(0, 2).Value
program.Value = f.Offset(0, 3).Value
email.Value = f.Offset(0, 4).Text
officenumber.Value = f.Offset(0, 5).Text
cellnumber.Value = f.Offset(0, 6).Text
Is this what it would look like...? I can't get it to work though?
Private Sub CommandButton1_Click()
MsgBox "Directorate has been added", vbOKOnly
Dim ctrl As control
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
'Pass this CheckBox to the subroutine below:
TransferValues ctrl
End If
Next
TransferMasterValue
End Sub
Sub TransferValues(cb As MSForms.CheckBox)
Dim ws As Worksheet
Dim emptyRow As Long
If cb Then
'Define the worksheet based on the CheckBox.Name property:
Set ws = Sheets(Left(cb.Name, 15))
emptyRow = WorksheetFunction.CountA(ws.range("A:A")) + 1
With ws
.Cells(emptyRow, 1).Value = surname.Value
.Cells(emptyRow, 2).Value = firstname.Value
.Cells(emptyRow, 3).Value = tod.Value
.Cells(emptyRow, 4).Value = program.Value
.Cells(emptyRow, 5).Value = email.Value
.Cells(emptyRow, 6).Value = officenumber.Value
.Cells(emptyRow, 7).Value = cellnumber.Value
End With
End If
End Sub
Sub TransferMasterValue()
Dim allChecks As String
Dim ws As Worksheet
'Iterate through the checkboxes concatenating a string of all names
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl Then
allChecks = allChecks & ctrl.Name & ""
End If
End If
Next
'If you have at least one transfer to the Master sheet
If Len(allChecks) > 0 Then
Set ws1 = Sheets("Master")
emptyRow = WorksheetFunction.CountA(range("A:A")) + 1
With ws1
.Cells(emptyRow, 1).Value = surname.Value
.Cells(emptyRow, 2).Value = firstname.Value
.Cells(emptyRow, 3).Value = tod.Value
.Cells(emptyRow, 4).Value = program.Value
.Cells(emptyRow, 5).Value = email.Value
.Cells(emptyRow, 7).Value = officenumber.Value
.Cells(emptyRow, 8).Value = cellnumber.Value
.Cells(emptyRow, 6).Value = Left(allChecks, Len(allChecks) - 1)
End With
End If
End Sub
Private Sub CommandButton2_Click()
Unload UserForm1
End Sub
Private Sub CommandButton3_Click()
surname.Value = ""
firstname.Value = ""
tod.Value = ""
program.Value = ""
email.Value = ""
officenumber.Value = ""
cellnumber.Value = ""
PACT.Value = False
PrinceRupert.Value = False
WPM.Value = False
Montreal.Value = False
TET.Value = False
TC.Value = False
US.Value = False
Other.Value = False
End Sub
Private Sub ListBox1_Click()
Dim r As Long
With Me.ListBox1
With Me
.surname.Value = .ListBox1.List(.ListBox1.ListIndex, 0)
.firstname.Value = .ListBox1.List(.ListBox1.ListIndex, 1)
.tod.Value = .ListBox1.List(.ListBox1.ListIndex, 2)
.program.Value = .ListBox1.List(.ListBox1.ListIndex, 3)
.email.Value = .ListBox1.List(.ListBox1.ListIndex, 4)
.officenumber.Value = .ListBox1.List(.ListBox1.ListIndex, 5)
.cellnumber.Value = .ListBox1.List(.ListBox1.ListIndex, 6)
End With
End With
End Sub
Private Sub Search_Click() 'only searches in master tab right now need to search from all worksheets
Dim Name As String
Dim f As range
Dim r As Long
Dim ws As Worksheet
Dim s As Integer
Dim FirstAddress As String
Name = surname.Value
With ws
Set f = range("A:A").Find(what:=Name, LookIn:=xlValues)
If Not f Is Nothing Then
With Me
firstname.Value = f.Offset(0, 1).Value
tod.Value = f.Offset(0, 2).Value
program.Value = f.Offset(0, 3).Value
email.Value = f.Offset(0, 4).Text
officenumber.Value = f.Offset(0, 5).Text
cellnumber.Value = f.Offset(0, 6).Text
End With
findnext
FirstAddress = f.Address
Do
s = s + 1
Set f = range("A:A").findnext(f)
Loop While Not f Is Nothing And f.Address <> FirstAddress
If s > 1 Then
Select Case MsgBox("There are " & s & " instances of " & Name, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
Case vbOK
findnext
Case vbCancel
End Select
End If
Else: MsgBox Name & "Not Listed"
End If
End With
End Sub
Sub findnext()
Dim Name As String
Dim f As range
Dim ws As Worksheet
Dim s As Integer
Dim findnext As range
Name = surname.Value
Me.ListBox1.Clear
Set f = range("A:A").Find(what:=Name, LookIn:=xlValues)
Set findnext = f
With ListBox1
Do
Debug.Print findnext.Address
Set findnext = range("A:A").findnext(findnext)
.AddItem findnext.Value
.List(0, 1) = findnext.Offset(0, 1).Value
.List(0, 2) = findnext.Offset(0, 2).Value
.List(0, 3) = findnext.Offset(0, 3).Value
.List(0, 4) = findnext.Offset(0, 4).Value
.List(0, 5) = findnext.Offset(0, 5).Value
.List(0, 6) = findnext.Offset(0, 6).Value
.List(0, 7) = findnext.Offset(0, 6).Value
Loop While findnext.Address <> f.Address
End With
End Sub
It doesnt seem like a coding problem, I saw the code where you set the textboxes text. Basically, instead of setting textboxes text, you'd be setting the checkbox. the code to to that is ChkCheck.value = true.
leave a comment if theres a deeper issue and ill make an edit
edit
To search all sheets,
I would put a loop in there like
for each ws in ActiveWorkbook.Sheets
and then put your search in there.
and then, after the if f is not nothing then
loop through all controls, and check to see if the controls name = the sheets name. -
if ctrl.name = ws.name then
ctrl.value = true
end if
like that
so then each time the sheets loop runs, if it finds the specific name, the checkbox accosiated with the particular sheet will check.