Using a userform to adjust a range of cells - vba

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).

Related

Assign macro to a cell corresponding to the row of automatically generated buttons

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.

Check if variant is Null or an array

I have a dynamic range that is being used to set a combobox in vba.
The range starts as A3 (which will contain nothing to start) and goes all the way to A3:A9999, depending on how many elements are in the range.
The code then pulls in the data from the range and stores it in a local variant.
My code in VBA is this:
If tempj <> Null Then
cmb_JobNum.List = tempj
End If
When there are 0 elements in the array, tempj = Null, so it does not attempt to set the list.
When there is 1 element in the array, tempj = [Value of cell], so it will set the list to that single element.
When there is 2 or more elements in the array, tempj is now an array, so trying to equate it to a single element throws a 'type mismatch' error. I have no clue how to update the code so that it doesn't get caught out by that error, since every time that equate is run it will crash.
You could try like this:
Dim i As Long
For i = LBound(tempj) To UBound(templ)
cmb_JobNum.AddItem tempj(i)
Next
This code will loop through your array and add every element in it to the combobox. Thus, if array is empy, then no elelements will be added, when there's >0 elements, then all of them will be added.
Here is an example using a dynamic named range to set the fill
Option Explicit
Public Sub test()
With ThisWorkbook.Worksheets("Sheet6") '<== change as appropriate
.ComboBox1.ListFillRange = .Range("dynRange").Address
End With
End Sub
dynRange formula added via name manager (Ctrl + F3)
=OFFSET(Sheet6!$A$3,0,0,COUNTA(Sheet6!$A:$A),1)
Using a worksheet change event to automatically update the combobox:
You could tie this into a Worksheet_Change event on the range A3:A9999 to update automatically the Combobox.
If tying to an event in the code pane of the sheet containing the combobox you could have the following:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A3:A9999")) Is Nothing Then
Application.EnableEvents = False
Me.ComboBox1.ListFillRange = ThisWorkbook.Worksheets("Sheet6").Range("dynRange").Address
Application.EnableEvents = True
End If
End Sub
Example code run:
Code pane for sheet containing Combobox:
Note:
This is assuming an ActiveX combobox but can easily be update for a Form Control ComboBox.
For a form control swop out lines and use:
With Shapes("Drop Down 2").ControlFormat '<== change to appropriate name
.ListFillRange = ThisWorkbook.Worksheets("Sheet6").Range("dynRange").Address
End With
Edit: For UserForm combobox you can populate in the initialize e.g.
Private Sub UserForm_Initialize()
cb1.RowSource = Sheet1.Range("dynRange").Address
End Sub
Figured it out
If VarType(tempj) <> 0 Then
If VarType(tempj) = 8 Then
cmb_JobNum.AddItem tempj
Else
cmb_JobNum.List = tempj
End If
End If

VBA - Strange Combobox/Listbox behaviour

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

Adding combo box across multiple cells

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)

Searching and Returning bold values in VBA

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