I want an user to select on which sheets he wants to create a new line of text. But the number of sheets he is able to select may vary over time and I don't want to hardcode the sheets' name.
Here is an example ("o" represents the checkbox) of what I aim to do:
o 01.2013
o 07.2013
o 01.2014
o 07.2014
I created an userform with an empty frame to put my checkboxes, and added this bit of code to the userform:
Private Tck(10) As MSForms.CheckBox
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim i As Long
i = 1
For Each ws In ActiveWorkbook.Worksheets
If Left(ws.Name, 3) = "T2M" Then
Set Tck(i) = Frame1.Controls.Add("Forms.Checkbox.1", "Checkbox" & i)
Tck(i).Caption = Right(ws.Name, 7)
i=i+1
End If
Next
End Sub
But it only adds one checkbox with the last sheet which validates the if test.
I tried to make an offset between the two iterations but I can't modify the position of the Tck(i) using Tck(i).top for example.
I also tried the method from the answer of this question : Adding controls to a frame in an Excel userform with VBA but it dosen't work either.
Your checkboxes are there, you just can't see them because they're overlayed on top of each other. You had the right idea with changing the 'Top' value.
Public Sub addCheckboxes()
Dim ws As Worksheet
Dim i As Integer
Dim tck As MSForms.CheckBox
Dim offset As Integer: offset = 5
For i = 1 To Worksheets.Count
Set ws = Worksheets(i)
Set tck = Frame1.Controls.Add("Forms.Checkbox.1", "Checkbox" & i, True)
tck.Top = offset
offset = offset + 15
Next i
End Sub
Related
on one sheet I have a list of suppliers and their details, I have a userfrom containing a combobox that automatically populates from the list of suppliers. In the columns next to the suppliers, I have details with address, phone number etc. What I am attempting to do is after the user makes the selection, I would like the code to take the details in the adjacent columns and fill in the form. I have tried using the lookup function however I am constantly being given an error stating that the object could not be found. Below is what I have so far
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Set ws = Worksheets("RFQ Information")
'Take supplier name from combobox
'Copy row data in supplier sheet and paste (transposed) into form
Dim xRg As Range
Set xRg = Worksheets("Suppliers").Range("A2:H15")
Set Cells(53, 1) = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, xRg, 2, False)
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim SupplierName As Range
Dim SupSheet As Worksheet
Dim tbl As ListObject
Dim SupArray As Variant
Dim SupString As String
Set SupSheet = Sheets("Suppliers")
Set tbl = SupSheet.ListObjects("Table1")
Set SupplierName = tbl.ListColumns(1).DataBodyRange
SupArray = SupplierName.Value
ComboBox1.List = SupArray
UserForm1.Show
MsgBox ("done")
End Sub
I would recommend using the ComboBox Change event instead of a button, since you want the info on list selection. You can also take advantage of the ComboBox.ListIndex property to get the selected item's location in the list, and then use that to get adjacent values from your data table. Here's a quick example of how to do so:
Private Sub ComboBox1_Change()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsSup As Worksheet: Set wsSup = wb.Worksheets("Suppliers")
Dim rData As Range: Set rData = wsSup.ListObjects("Table1").DataBodyRange
Dim i As Long: i = Me.ComboBox1.ListIndex + 1
If i = 0 Then Exit Sub 'Nothing selected
'Second number is the column
' Column 1 is the Supplier
' Column 2 is the next column (phone maybe?)
' Column 3 is the column after that (address maybe?)
MsgBox rData.Cells(i, 2) & Chr(10) & _
rData.Cells(i, 3)
'Load the values you want into the necessary form controls
End Sub
From the picture on the left side, it is the input and after the user presses the button the output will appear on the right side.
My problem is that after the user presses the button and the result appears. I want the inputted data on the left side to disappear so that the user can re-input the data again and again
What do I need to add in my code so that it will give the result I want.
This is my code:
Private Sub CommandButton1_Click()
Dim i As Long, j As Long
Dim wks As Worksheet
Set wks = Worksheets("Sheet1")
Set AddNew = wks.Range("M65356").End(xlUp).Offset(5, 0)
For i = 1 To 15
For j = 1 To 7
AddNew.Cells(i, j) = wks.Range("B1").Cells(i, j)
Next j
Next i
End Sub
Just add :
wks.Range("B1").Cells(i, j) = ""
After your AddNew line
Your current code skips over the last inputline (15). But maybe consider to not use loops but to transfer the data in one go:
Private Sub CommandButton1_Click()
Dim wks As Worksheet: Set wks = Worksheets("Sheet1")
Dim AddNew As Range: Set AddNew = wks.Range("M65356").End(xlUp).Offset(5, 0)
AddNew.Resize(16, 7).Value = wks.Range("B1:H16").Value
wks.Range("B1:H16").Value = ""
End Sub
I am creating a userform that is entering data on a form. And in that userform I have a Combobox that list out all the products. For each product there a row and the data that is being inputted in would only be on that row.
Private sub cwbSave_Click()
Dim ws as Worksheet
Set ws = ActiveWorkbook.ActiveSheet
with ws
Select Case cbProduct
Case Is = "Apple"
With ActiveSheet.Range("A14:P14")
.Font.Bold = True
End With
ws.Cell(14,4) = Me.tbPrice
ws.Cell(14,5) = Me.tbColor
ws.Cell(14,6) = Me.tbSell
Case Is = "Pineapple"
With ActiveSheet.Range("A15:P15")
.Font.Bold = True
End With
ws.Cell(15,4) = Me.tbPrice
ws.Cell(15,5) = Me.tbColor
ws.Cell(15,6) = Me.tbSell
End Select
End With
End Sub
But the thing is, I got like 30 products. And it a lot of manually putting in. I was wondering if there an easier way to code this.
Thank you
There are several ways to do this.. here is one:
In the UserForm_Initialize, add the below code:
Private Sub UserForm_Initialize()
Dim aValues As Variant: aValues = WorksheetFunction.Transpose(ThisWorkbook.Worksheets("Sheet2").Range("A2:A5")) ' Change sheet name and range to where your products are
Dim iRow As Long
' Clear combobox
Me.cmbCmbBox.Clear
' Fill combobox with the values from product range
For iRow = LBound(aValues) To UBound(aValues)
Me.cmbCmbBox.AddItem aValues(iRow)
Next
End Sub
Above code uses your product range to populate the combobox. Now in cmbCmbBox_Change, add the following code:
Private Sub cmbCmbBox_Change()
Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet2")
Dim rProdRange As Range: Set rProdRange = oWS.Range("A2:A5")
Dim rItemRange As Range
' Find the selected item
Set rItemRange = rProdRange.Find(Me.cmbCmbBox.Value)
' Set value in the sheet
If Not rItemRange Is Nothing Then
oWS.Cells(rItemRange.Row, 4) = Me.tbPrice
oWS.Cells(rItemRange.Row, 5) = Me.tbColor
oWS.Cells(rItemRange.Row, 6) = Me.tbSell
End If
End Sub
You can add validation for when product is not found
I'm not a programmer for the profession, I'm a system administrator who usually brings together the puzzle when I try something. Now I would need help simplifying an Excel form to make it useful. It will be used by me.
I have a combobox that contains 4 columns. I also have a button. When you click the button, I want to save data from the four columns in my combobox to the next available row of cells starting from row 3. I want data to be saved only to row 30. I have tested back and forth but do not get it, so I've completely deleted the code. Any ideas?
Sheet named "Data"
I use ListFillRange in my ComBobox for the data source.
Private Sub CommandButton1_Click()
Call SaveComboBoxData
End Sub
Sub SaveComboBoxData()
End sub
Using ActiveX controls
ComboBox1
CommandButton1
You can tidy this up further,
Note:
You appear to be building a database so consider the preferred option of using an access database to store this data
If you have Excel 2016 you could be using Data Entry Forms instead which are dead simple.
Assume using ActiveX combobox. You will need to alter this
Set sourceCombo = sourceSheet.OLEObjects("Combobox1").Object
if working with a form control.
Code for the type of operation you are describing:
Code pane for Order sheet:
Option Explicit
Private Sub CommandButton1_Click()
AddRecords
End Sub
Standard module
Option Explicit
Public Sub AddRecords()
Dim wb As Workbook
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Set wb = ThisWorkbook
Set sourceSheet = wb.Worksheets("Order")
Set targetSheet = wb.Worksheets("Data")
Dim lastRowTarget As Long
Dim sourceCombo As ComboBox
Set sourceCombo = sourceSheet.OLEObjects("Combobox1").Object 'assume activex object
Dim lRow As Long
Dim lCol As Long
Dim nextRow As Long
With sourceCombo
For lRow = 0 To .ListCount - 1
If lRow = sourceCombo.ListIndex Then
nextRow = GetNextRow(targetSheet)
If nextRow = 31 Then
MsgBox "End row of 30 reached"
Exit Sub
End If
For lCol = 0 To .ColumnCount - 1
targetSheet.Cells(nextRow, lCol + 1) = .List(lRow, lCol)
Next lCol
Exit For
End If
Next lRow
End With
End Sub
Private Function GetNextRow(targetSheet As Worksheet) As Long
With targetSheet
GetNextRow = IIf(.Cells(.Rows.Count, "A").End(xlUp).Row < 3, 3, .Cells(.Rows.Count, "A").End(xlUp).Row + 1)
End With
End Function
Code in action:
References:
How to get selected value in multicolumn listbox
How can I find the index of the selected choice in a combobox?
How to create a data entry form
I recently creating a workbook which contains a userform with a combobox, named "combobox1"
I have a code that brings data from other workbook in direction shown below whith range "B2:B...."
now i want to make it how to have a tow columns in a combobox the other column shuld bring data from same directory but the range for exp: "A1:A...."
i need your help
thx.
[Private Sub UserForm_Initialize()
`Dim ListItems As Variant, i As Integer
`Dim SourceWB As Workbook
With Me.ComboBox1
.Clear ' remove existing entries from the listbox
' turn screen updating off,
' prevent the user from seeing the source workbook being opened
Application.ScreenUpdating = False
' open the source workbook as ReadOnly
Set SourceWB = Workbooks.Open("C:\Users\Mohsen\Desktop\new prj\Data base\partlist.xls", _
False, True)
ListItems = SourceWB.Worksheets(1).Range("B2:B1468").Value
' get the values you want
SourceWB.Close False ' close the source workbook without saving changes
Set SourceWB = Nothing
Application.ScreenUpdating = True
ListItems = Application.WorksheetFunction.Transpose(ListItems)
' convert values to a vertical array
For i = 1 To UBound(ListItems)
.AddItem ListItems(i) ' populate the listbox
Next i
.ListIndex = -1 ' no items selected, set to 0 to select the first item
End With
End Sub
Your question is not clear about where the second column of data should come from so I have assumed that the first combobox column is from SourceWB, Sheet1, column B and that the second combobox column is from the same sheet in the column to the left of column B. You can change these to suit.
I have also coded to identify the last datarow in column B. This will prevent searching 1468 rows unnecessarily. Again, please change if this is not helpful.
Option Explicit
Private Sub UserForm_Initialize()
Dim ListItems As Variant
Dim i As Integer
Dim SourceWB As Workbook
Dim listVal As Range
Dim srcLastRow As Long
'for testing purposes
Dim srcName As String
srcName = "C:\Users\Mohsen\Desktop\new prj\Data base\partlist.xls"
With Me.ComboBox1
'Set the number of columns by code
.ColumnCount = 2
.Clear
Application.ScreenUpdating = False
Set SourceWB = Workbooks.Open(srcName, False, True)
'find the last row of data to prevent searching 1468 rows unnecessarily
srcLastRow = SourceWB.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
For Each listVal In SourceWB.Sheets(1).Range("B2:B" & srcLastRow)
.AddItem listVal.Value
'Offset(0,-1) gets second column of data from cell to the left
.List(.ListCount - 1, 1) = listVal.Offset(0, -1).Value
Next listVal
SourceWB.Close False
Set SourceWB = Nothing
Application.ScreenUpdating = True
.ListIndex = -1
End With
End Sub
Take a look at the Properties window for Combobox1, for other properties that you may require to set within the code.