The following code is a part of a bigger program to gather up a set of production orders that tracks movements, which need to be posted in SAP.
This particular routine is straightforward, it simply collects orders, puts them in an array and puts the list in a combo box.
The problem I'm having is that if I use an array as an approach, the combo box populates as expected, no errors whatsoever, except that the list is there, but invisible. The option, if clicked, will come up correctly, otherwise.
Alternatively, if I do the same thing with the AddItem method, things are visible.
I've observed the same behaviour with listboxes, the items in them will populate, but be invisible, if I try it with an array, but are visible with an addItem approach. I've tested the code with both methods, reset Excel and my computer, and tried to figure out if it's some property I've clicked by accident, but nothing jumps out.
Code is below for reference
Thank you in advance.
Private Sub POs_for_SAP()
'this routine is going to create the list of POs and populate the combo box with them
Dim lstcl As Variant, cell As Range, arr_po() As Variant, x As Integer
With ThisWorkbook.Sheets("Staging")
lstcl = .Range("B10000").End(xlUp).row
'UserForm12.cboPOSAP.Clear
For Each cell In .Range("B4:B" & lstcl)
If Not IsEmpty(cell) And IsEmpty(cell.Offset(0, 7)) Then
'UserForm12.cboPOSAP.AddItem cell
ReDim Preserve arr_po(x)
Set arr_po(x) = cell
x = x + 1
End If
Next
End With
With UserForm12.cboPOSAP
.Clear
.List = arr_po()
.Style = fmStyleDropDownList
End With
UserForm12.Show
End Sub
In Array no need set statement.
Private Sub POs_for_SAP()
'this routine is going to create the list of POs and populate the combo box with them
Dim lstcl As Variant, cell As Range, arr_po() As Variant, x As Integer
With ThisWorkbook.Sheets("Staging")
lstcl = .Range("B10000").End(xlUp).Row
'UserForm12.cboPOSAP.Clear
For Each cell In .Range("B4:B" & lstcl)
If Not IsEmpty(cell) And IsEmpty(cell.Offset(0, 7)) Then
'UserForm12.cboPOSAP.AddItem cell
ReDim Preserve arr_po(x)
arr_po(x) = cell '<~~~no need set
x = x + 1
End If
Next
End With
With UserForm12.cboPOSAP
.Clear
.List = arr_po()
.Style = fmStyleDropDownList
End With
UserForm12.Show
End Sub
Related
I've managed to create a form where the user can expand the fields of a pivot table and, once they've completely expanded a field/branch, a button will appear in column E and that pivot field data is concatenated in column J (there are some hidden columns).
What I want is for the user to click an auto-generating button in column E which exports the corresponding data in column J to a list, somewhere on the workbook.
My code below automatically generates the buttons for fully expanded fields, but I have no idea how to write the code to link each button to the corresponding cell in column J - this is probably not very difficult but any help would be appreciated.
Sub buttonGenerator()
Dim btn As Button
Application.ScreenUpdating = False
ActiveSheet.Buttons.Delete
Dim t As Range
Dim size As Integer
size = ActiveSheet.PivotTables("Pivottable1").TableRange2.Rows.Count
For i = 2 To size Step 1
If Not IsEmpty(ActiveSheet.Range(Cells(i, 4), Cells(i, 4))) Then
Set t = ActiveSheet.Range(Cells(i, 5), Cells(i, 5))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "btnS"
.Caption = "Add to summary" '& i
.Name = "Btn" & i
End With
End If
Next i
Application.ScreenUpdating = False
End Sub
Sub buttonAppCaller()
MsgBox Application.Caller
End Sub
So here is my code .. it is throwing Runtime error 1004 "Unable to get the Buttons property of the worksheet class". Not sure what I've done wrong but I need to get the data from the cell next to the button to copy over to the bottom of a list in sheet 2 when that particular button is clicked. Please help!
Sub btnS()
Dim dest As Range
Dim origin As Range
origin = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Offset(0, 1) 'input data from cell next to button click
dest = Worksheets("Form Output").Range("A1") 'output data to list in sheet 2 - "Form output"
Set dest = origin
End Sub
Don't use Integer for row counts as you did for size. Excel has more rows than Integer can handle. It is recommended always to use Long instead of Integer in VBA there is no benefit in Integer at all.
The procedure every button invokes is called btnS as you defined in .OnAction = "btnS". Therefore you need a Sub with that name in a Module.
You can use Buttons(Application.Caller).TopLeftCell to get the cell under a button and from that cell you can determine the row or column.
Public Sub btnS() 'sub name must match `.OnAction` name
MsgBox ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row
End Sub
Instead of using ActiveSheet I recommend to use a specific worksheet like Worksheets("your-sheet-name") if you plan to use it on a specific sheet only. ActiveSheet can easily change and should be avoided where possible.
I have much of this form
coded to what I want but I'm having difficulty with the most significant part of it. As shown in the image, the frame in the form with 30 textboxes is designed to have names entered in it. Each box has a different name. When I click "save data" button I want the names in the textboxes to be entered on the next available row on the worksheet, also in the image.
So, if the form has Bob, Joe, and Jane in the first three boxes, I'd want rows A:2-4 in the worksheet to be populated with each name respectively.
If you can't (or don't want to) rely on textbox names, there are two possible ways out:
exploit TabIndex
if your textboxes inside "Individuals" frame have same TabIndex order as the cells you want to write their content into, then you could go as follows:
Dim i As Long
Dim strng As String
With Me.Frame1 '<--| change "Frame1" to your actual "Individuals" frame name
For i = 0 To .Controls.Count - 1
strng = strng & GetTextBox(i).Value & " "
Next
Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(.Controls.Count) = Application.Transpose(Split(Trim(strng), " "))
End With
where you exploit the following Function:
Function GetTextBox(tabId As Long) As Control
Dim ctrl As Control
For Each ctrl In Me.Frame1.Controls
If ctrl.TabIndex = tabId Then Exit For
Next
Set GetTextBox = ctrl
End Function
exploit Top and Left control properties
if your textboxes are properly vertically aligned (i.e. all texboxes in the same row share the very same Top property), then you could go as follows:
Dim dict As Object
Dim ctrl As Control
Set dict = CreateObject("Scripting.Dictionary")
With dict
For Each ctrl In Me.Frame1.Controls
.Item(Format(ctrl.Top, "000") & "-" & Format(ctrl.Left, "000")) = ctrl
Next
End With
SortDictionary dict
Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(Me.Frame1.Controls.Count) = Application.Transpose(dict.items)
where you exploit the following Function:
Sub SortDictionary(dict As Object)
Dim i As Long
Dim key As Variant
With CreateObject("System.Collections.SortedList")
For Each key In dict
.Add key, dict(key)
Next
dict.RemoveAll
For i = 0 To .Keys.Count - 1
dict.Add .GetKey(i), .Item(.GetKey(i))
Next
End With
End Sub
I need to add combo box(ActiveX Control) or Data Validation as drop down list.
I have a range of 15 values like, high, low, medium,etc...
Have created named range called "priorityvalue".
I can create a dropdown list using combo box by adding named range under ListFillRange in the properties or data validation list by giving named range.
But my concern, I need to dropdown list for 58cells with same values mentioned above. Its tedious job to create combo box for all cells. Please suggest me better option here.
Data validation list serves the purpose. However, it makes user to scroll through dropdown list on each cell unlike combo box it has no input box..
Please suggest
Paste the below code in 'ThisWokbook'
Private Sub Workbook_Open()
Dim oItem As Object
For Each oItem In Worksheets(1).OLEObjects
If TypeName(oItem.Object) = "ComboBox" Then
If Len(oItem.Object.Value) > 0 Then
oItem.Object.Value = ""
End If
End If
Next
Set oItem = Nothing
End Sub
NOTE: There are caveats to this. Above code will reset all comboboxes in your worksheet (also, I've set the worksheet to the first worksheet in the workbook, you might want to make that dynamic). If you don't want it to reset all comboboxes and only do the ones you added via the function, you can use the name format to filter the ones you want to clear
Hope this helps
Try this:
Sub AddComboBoxToColumns(ByVal oRange As Excel.Range)
Dim oOLE As OLEObject
Dim oCell As Object
' Loop through all the cells in the range
For Each oCell In oRange.Cells
' Add ComboBox in each cell
With oCell
Set oOLE = .Parent.OLEObjects.Add("Forms.combobox.1")
oOLE.Top = .Top
oOLE.Left = .Left
oOLE.Width = .Width
oOLE.Height = .Height
oOLE.Name = "ComboBox" & .Address(False, False)
oOLE.Object.List = Array("Test1", "Test2")
End With
Next
Set oOLE = Nothing
End Sub
NOTE: Call the above function with the range of cells you want to add ComboBox to. You will have to change the Array to use the values you want (you can type them in there or give the range where your existing values are)
I know that this probably isn't the most ideal way to to do this but just bear with me.
I have a document with a few tables on it. I'm using a userform to search the tables/sub-categories and return the relevant values. I want to select the sub categories with a range of option buttons on a userform, these will in turn set the range for the search function to look within. I also want to dynamically update the option buttons if a new table was to be added or anything along those lines.
The only thing that differentiates the title of a sub-category/table, and the items within it, is that the title of a sub-category/table is bold. So what I'm looking to do is search the first column of the spreadsheet and return the names of any entries in bold. These values are then used to set the names of the option buttons :).
The following function is my attempt at finding the text entities in column a that are in bold, returning them and setting each to an individual variable to be used in another function. The bold1 .... variables are all globally defined variables as I need them in another sub, as is the page variable which contains the relevant page to be used. Currently the code returns an error stating "variable or with block not set" and using the debugger I can see that bold1 .... and all the other boldx variables have no value set. Does anybody know whats going on/how to fix this function.
Thanks in advance :)
Sub SelectBold()
Dim Bcell As Range
For Each Bcell In Worksheets(Page).Range("A1:A500")
If Bcell.Font.Bold = True Then
Set bold1 = Bcell
End If
Next
End Sub
EDIT: I simplified the above function, to remove clutter and help narrow in on the issue. I want the above function to store the contents of the found cell (any cell in the document in bold at this stage) in the variable bold1
This will return an array of values from bold cells in column A of Page.
You can fill a combo or list box with theses values using their list property.
ComboBox1.List = getSubCategories("Sheet1")
Function getSubCategories(Page As String) As String()
Dim arrSubCategories() As String
Dim count As Long
Dim c As Range
With Worksheets(Page)
For Each c In .Range("A2", .Range("A" & Rows.count).End(xlUp))
If c.Font.Bold Then
ReDim Preserve arrSubCategories(count)
arrSubCategories(count) = c.Value
count = count + 1
End If
Next
End With
getSubCategories = arrSubCategories
End Function
you may find useful to have a Range returned with subcategories cells found:
Function SelectBold(Page As String, colIndex As String) As Range
With Worksheets(Page)
With .Range(colIndex & "1", .Cells(.Rows.Count, colIndex).End(xlUp)).Offset(, .UsedRange.Columns.Count)
.FormulaR1C1 = "=if(isbold(RC[-1]),"""",1)"
.Value = .Value
If WorksheetFunction.CountA(.Cells) < .Rows.Count Then Set SelectBold = Intersect(.SpecialCells(xlCellTypeBlanks).EntireRow, .Parent.Columns(1))
.Clear
End With
End With
End Function
Function IsBold(rCell As Range)
IsBold = rCell.Font.Bold
End Function
to be possibly exploited as follows:
Option Explicit
Sub main()
Dim subCategoriesRng As Range, cell As Range
Set subCategoriesRng = SelectBold(Worksheets("bolds").Name, "A") '<--| pass worksheet name and column to search in
If Not subCategoriesRng Is Nothing Then
For Each cell In subCategoriesRng '<--| loop through subcategories cells
'... code
Next cell
End If
End Sub
I am hoping someone can help me with a query. So far I have an excel spreadsheet and you select a cell and then click a button, the button opens a userform with a scroll bar on and as you use the scroll bar this edits the number in cell by +-1 up/down to bounds that you type into text boxes. This moves the graphs associated with each cell in real time. When I close the userform, the original values are populated back in the cells.
My hope is that when using the spreadsheet, eventually, people will be able to select a number of cells (a random number of cells, sometimes you might select 2 or 7 or 10 to change) and the userform will impact all of them in the same way above however I am having trouble with this. This will enable people to see the impact of the interaction between these items.
To make it work for one cell I have defined the variable as public outside the user form as so:
Public SelRange As Integer
Then within UserForm_Initialize:
SelRange = Selection
Then there is code for max, min, increments etc and when the scroll bar is used, the value is deposited in the active cell by the code:
Selection = SelRange
However if I select numerous cells and try do this I get a type mismatch which would suggest I should define the SelRange in a different way but I can't figure out what this is or even if that will actually help the situation.
Thanks for your help.
Full code below:
Code for Button:
Public SelRange As Integer
Sub Button1_Click()
UserForm1.Show
End Sub
Code for Scroll Bar within userform:
Option Explicit
' Sets default values for when the Userform is opened
Public Sub UserForm_Initialize()
MinBox.Value = -100
MaxBox.Value = 100
IncBox.Value = 5
SelRange = Selection
End Sub
'Ensures that the default starting point is midway between the min and max values specified
Sub scrollbar1_enter()
Dim x As Double
Dim y As Double
y = MaxBox.Value
x = MinBox.Value
ScrollBar1.Value = (x + y) / 2
Selection = SelRange
End Sub
'Sets all parameters in the scroll bar
Private Sub Scrollbar1_Change()
ScrollBar1.Max = MaxBox.Value
ScrollBar1.Min = MinBox.Value
ScrollBar1.LargeChange = IncBox.Value
ScrollBar1.SmallChange = IncBox.Value
Selection = ScrollBar1 + SelRange
End Sub
'Default on exit of userform
Private Sub ScrollBar1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim x As Double
Dim y As Double
y = MaxBox.Value
x = MinBox.Value
ScrollBar1.Value = (x + y) / 2
End Sub
'ensures activecell is updated in real time with dragging of mouse
Private Sub ScrollBar1_Scroll()
Selection.Value = ScrollBar1.Value + SelRange
End Sub
Your current code is working for one cell because the default property of the Range object is Value. So you are putting the value in the selected cell into your variable. But for multiple cells, the Value property will return an Array - which won't fit into the Integer.
It looks like you need to declare selRange as a Range then work with that:
Public selRange as Range
'...
If TypeName(Selection) = "Range" Then
Set selRange = Selection
Else
'handle case when something other than cell(s) are selected here
End If
'rest of your code here
Look up the Range object reference in MSDN for info on working with Range. The Cells and Value properties will be particularly useful. In particular, to increment each cell in a range you can do:
Dim getAllValuesAtOnceAsArray As Variant
getAllValuesAtOnceAsArray = selRange.Value
Dim singleCell As Range
For Each singleCell In selRange.Cells
singleCell.Value = singleCell.Value + 1
Next singleCell
'Now write back the original values
selRange.Value = getAllValuesAtOnceAsArray
One thing to note is that Range.Value always returns a 2D array if there is more than one cell (even if the range has only one row or one column). So getAllValuesAtOnceAsArray(rowNumber,columnNumber) gets a single element of the array - and you need both indices even if one is always 1. In practice it's usually easier to just use the Range object as there are more flexible ways of accessing the individual cells (Cells, Offset, Rows, Columns etc).