Adding several elements to a listbox menu in vba - excel

I am trying to create a menu with list boxes in order to be able to select a number of customers from a list in an excel sheet. There are two list boxes, one with all the (default) data and one with the selected customers.
There is no problem adding one customer but when I add a second customer the graphic interface shows nothing, but after some debugging, the SelectedCustomers.RowSource still have the two rows in its data:
?SelectedCustomers.RowSource
$8:$8,$11:$11
This would have me believe there is some error with how I save the data or some limitations to Excel that I am not aware of. This is the code I use to save the data:
Private Sub CommandButton5_Click()
Dim temp As Range
For i = 0 To DefCustomers.ListCount - 1
If DefCustomers.Selected(i) = True Then
If temp Is Nothing Then
Set temp = Range(Rows(i + 4).Address)
Else
Set temp = Application.Union(temp, Range(Rows(i + 4).Address))
End If
End If
Next i
SelectedCustomers.RowSource = temp.Address
End Sub
Has someone experienced this before or know what the problem might be?

Instead of RowSource use AddItem method:
For i = 0 To DefCustomers.ListCount - 1
If DefCustomers.Selected(i) Then
SelectedCustomers.AddItem DefCustomers.Selected(i)
End If
Next i
There are known issues with ListBox.RowSource property in Excel VBA.
[EDIT]
After the discussion...
No matter of number of columns, you can copy rows from source sheet into another sheet, then bind SelectedCustomers listbox to that data

Related

VBA Range.End(xlDown) stops at last visible row

I am doing a simple VBA script in Microsoft Excel which iterates a list of cars and a list of information about when the cars were refueled to provide an overview of how many kilometers each car is driving each month.
I make use of the Range.End property to calculate the number of rows with data and then loop through the indicies.
Set Data = Worksheets("Tankninger") ' Danish for refuellings
NumRows = Data.Range("A1", Data.Range("A1").End(xlDown)).Rows.Count
For x = 1 To NumRows
' Process data
Next
Everything seemed to be working fine, however I found that if someone applied a filter to e.g. the sheet with refuelling data - e.g. only showing data related to car A, then NumRows would be assigned the index of the last visible row.
Example: if the refuling sheet contains 100 records and the records related car A are located on row 50-60, then NumRows would be assigned the value 60 - resulting in my script ignoring the last 40 records.
Is there a way to make the Range.End property ignore any filter applied to sheet, or will I have to change the implementation to use a while-loop instead?
I ended up replacing the for-loop with a while-loop. This allowed me to access every cell regardless of any filtering applied to the sheets.
Set Data = Worksheets("Tankninger") ' Danish for refuellings
r = 2
While Not IsEmpty(Cars.Cells(r, 1).value)
' Process data
Wend
What you can do is add the following in your code to remove filters before you find the last row with data.
'Remove all filters
Worksheets("Sheet1").Activate
On Error Resume Next
ActiveSheet.ShowAllData

How to generate a three level dependable dropdown list

I am a complete VBA beginner and this is the first time I have had to deal with VBA. My project is simple- a user form which heavily relies on dependent drop down lists. I watched a ton of videos and wrote (more like copy-pasted) code which actually works just fine. My issue is that I need to edit part of my code to add a feature which I have trouble finding a video on (trial and error editing only took me this far).
In it's current state, my form has two dropdown lists drawing information from a sheet where data is arranged in columns as follows:
ITEM ID | ITEM | CATEGORY
The user picks a category and then the item list if filtered based on the previous selection. I now need to rearrange those columns are add another one, making it the 1st tier selection as follows:
LOCATION | CATEGORY | ITEM ID | ITEM
Just rearranging the columns alone breaks my code. On top of that I need to add the Location combobox, which would filter the Categories, which in turn filter the Items.
This is the code which handles the CATEGORY and ITEM list:
Private Sub cmbEquipCategory_Change()
Dim sh As Worksheet
Dim lastBlankRow As Long
Me.cmbEquipment.Clear
Set sh = Sheets("Equipment_List")
lastBlankRow = sh.Cells(Rows.Count, 3).End(xlUp).Row
For i = 2 To lastBlankRow
If sh.Cells(i, 3) = Me.cmbEquipCategory.value Then
Me.cmbEquipment.AddItem sh.Cells(i, 2)
End If
Next i
End Sub
It is my impression that I need to alter this code to draw data from columns 2 and 4 (it currently does so from 3 and 2) and write another almost identical block of code which handles LOCATION and CATEGORY. Any advice, resources or help would be greatly appreciated. Thanks!
The way I do this is to used named ranges. So selecting your ITEM ID would lead to one of several ITEM ranges (I name them according to the ITEM ID options) which would lead to one of several CATEGORY ranges (I name these according to the ITEM options). The more options you have the more ranges you need. Named ranges aren't broken by adding in columns.

Copy & Pasting values from one Table to another using VBA and ListObjects

I am trying to compare spending data from two sources: a curated manual input from users and an automated extract, for different business units. The common data from both sources is the ID of the spending.
The idea is to aggregate both data sources (excel Tables) into one Table where the first two columns are the ID of the spending, the next column is the spending data from users related to that ID and the last one is the spending data from automated extract.
In this table, I'll have "double" the total spending for each ID, but then I can do a pivot table where I'll clearly compare the users input with the automated extract for each ID.
I highlighted the important fields I need to copy and paste.
[![PGIvsManual][3]][3]
My code is the following
Sub PGIvsManualInput()
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set PGIvsManualTable = Worksheets("PGI vs Dépenses (Auto)").ListObjects("PGIvsManualInputAuto")
Set PGITable = Worksheets("PGI Clean").ListObjects("PGIExtract")
Set ManualInputTable = Worksheets("Dépenses").ListObjects("Dépenses")
'Cleaning the table
With Worksheets("PGI vs Dépenses (Auto)").Range("PGIvsManualInputAuto")
.ClearContents
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With PGIvsManualTable
If .ListRows.Count >= 1 Then
.DataBodyRange.Rows.Delete
End If
End With
'Copy the data
PGITable.ListColumns(1).DataBodyRange.Resize(, 2).Copy Destination:= _
PGIvsManualTable
Ant that's where it gets messy. I can't even get the first batch of data to properly import! I am trying to copy the 2 first columns from PGITable and paste them in the 2 first columns of PGIvsManualTable. This worked previously without defining any destination column in my first example, even though both the input and destination Tables didn't have the same number of columns
But in this case, it extends the pasting to all columns of my destination table! I don't understand this comportment as it doesn't happen on my previous example with basically the exact same code!!
I tried to set the destination as follows but always got errors:
PGIvsManualTable.ListColumns(1).DataBodyRange.Resize(, 2) ==> Error 91
PGIvsManualTable.DataBodyRange(1,1) ==> Error 438
PGIvsManualTable.ListColumns(1).Resize(, 2) ==> Error 438
And a few others, but it never worked properly.
I expect the output to be my selected columns copy/pasted properly in my destination column, based on the coordinates I provide in the ListObecjts.DataBodyRange.
I guess that if I manage to make this first import work, all other will work on the same template, but in the meantime, my code seem to work on the previous example.
Deletion of the DataBodyRange.Rows will cause an issue if you then try to paste into the DataBodyRange.
As a workaround, you could delete all rows after the first, something like this example:
Sub Test()
Dim firstTbl As ListObject, secondTbl As ListObject
Set firstTbl = Sheet1.ListObjects("Table1")
Set secondTbl = Sheet1.ListObjects("Table2")
With secondTbl
.DataBodyRange.Clear
If .ListRows.Count > 1 Then
.DataBodyRange.Offset(1).Resize(.ListRows.Count - 1).Rows.Delete
End If
End With
firstTbl.ListColumns(1).DataBodyRange.Resize(, 2).Copy secondTbl.DataBodyRange(1, 1)
End Sub

Excel allows adding rows manually, but not from VBA

This has been asked already, but none of the answers available helps me. I am trying to add a row to a small worksheet. I am allowed to add the row with Alt-I, R manually, but if I try to do it from a macro, I get this:
I have tried, without effect, the following suggestions I have found on the Internet:
Check that data isn’t ridiculously long. Ctrl-End takes me to G40. The last available row is 1048576.
Unfreeze panes.
Execute “ActiveSheet.UsedRange” in the Immediate window.
Unmerge cells in row above the one I was inserting.
Rows("1048500:1048576").Delete. This ought to free up 76 rows, yet immediately after it attempting to insert just one row is forbidden.
Application.CutCopyMode = False
Selecting all the rows below those used and choosing “Clear Content”, save, close and reopen.
I am using Excel 2016. The only solution that looks at all plausible is using Application.SendKeys to do Alt-I, R, but I would rather not do that if I can help it. Neither the sheet nor the workbook containing it is protected. If you want to know what the offending code is:
For iWorksheetCounter = 2 To wbkFinal.Worksheets.Count
Set wksPartial = wbkFinal.Worksheets(iWorksheetCounter)
lngCurrentRow = iWorksheetCounter + iRowOffset ' iRowOffset = 3
wksTotals.Rows.Insert (lngCurrentRow + 1) ' this is not allowed for a reason I don't understand
wksTotals.Cells(lngCurrentRow, 1).Value = wksPartial.Name
Next ' iWorksheetCounter

Excel 2010: Macro for hidden column groups

VBA is not my particular strength, but here we go:
I would like to trigger a macro once a group of columns is hidden or shown. How can I archive this?
The results of my previous research
The only good hint about this I could find is this discussion at MSDN. Here, a solution is using the following way is drafted:
From the root dir of the xlsx file create a file customUI\customUI.xml with the content
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" >
<commands >
<command
idMso="ColumnsHide"
onAction="ColumnHide_onAction"/>
<command
idMso="ColumnsUnhide"
onAction="ColumnUnhide_onAction"/>
</commands >
</customUI >
and add
<Relationship Id="edTAB" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml" />
to the _rels\_rels.xml. (All this probably is much easier using Visual Studio, but I have no access to such sophisticated tools in the microsoft world...) Now, the macro can be used the following way:
Public Sub ColumnHide_onAction(control As IRibbonControl, ByRef cancelDefault)
'
' Code for onAction callback. Ribbon control command
'
MsgBox "Ribbon Column Hide"
cancelDefault = False
End Sub
Public Sub ColumnUnhide_onAction(control As IRibbonControl, ByRef cancelDefault)
'
' Code for onAction callback. Ribbon control command
'
MsgBox "Ribbon Column Unhide"
cancelDefault = False
End Sub
This approach perfectly catches hiding and unhiding of columns, but not hiding and unhiding of groups. So, close, but not quite there.
Downloading the possible idMso values from here, I got notice of the GroupViewShowHide control. Using this the same way as ColumnsHide or ColumnsUnhide does not archive the desired result, though.
Any ideas?
For hiding groups of columns, I've noticed you haven't used the .Hidden property in your code example. It can be quite useful, especially if you define a group of columns in an array. For example:
For byti = 0 To UBound(cols())
If Hide Then
ActiveSheet.columns(cols(byti)).EntireColumn.Hidden = True
...and so on.
To check if a group of columns is already hidden or not, you could also use an array. Group your columns by assigning them to an array, then compare your worksheet's current status (what columns are hidden, what are not) to that array.
The code below is a suggestion for starting, and you could adapt to your project. It doesn't require the customUI.xml file you mentioned in your question.
The key parts are the MyColumnCheck variant, which is used to check if columns are hidden, and the .Match method. This is the VBA equivalent of the Match spreadsheet function.
Working on this code taught me much about how to search within arrays, and the ups and downs of using Match versus other methods - such as Find and just looping through an array! This has been discussed in several posts already, see this one for a good example. I chose to do Match rather than a For...Next loop, although it would be easy to include a For..Next loop that checks if a hidden column is in a group you assign.
If you're wondering about the IfError statement:
Application.IfError(Application.Match(MyColumnCheck.Column, MyColumnArray, 0),...
... this is because using Match in VBA code is often somewhat tricky as mentioned here. Also, as #Lori_m wrote here, "Using Application without .WorksheetFunction returns a variant which allows for arrays in arguments and results."
Also, I chose to change the values of the group array to -1 as they were checked, so when the procedure was done a little simple math would reveal if all the columns referenced by the array were hidden. A negative number is better for this check because I'm assuming you would refer to an actual column with only positive numbers.
So, to sum up, .Match can be used effectively to check if the hidden columns on a worksheet match a group of columns defined by an array.
'the column group you're looking for, dim as a dynamic array of column numbers
Dim MyColumnArray(1) As Long
'MyColumnArray(0) is column 2 or "B", MyColumnArray(1) is column 3 or "C", etc
MyColumnArray(0) = 2
MyColumnArray(1) = 3
Dim MyColumnCheck As Variant 'column check
For Each MyColumnCheck In Worksheets("Sheet1").columns
'if the column is hidden and exists in MyColumnArray array...
If columns(MyColumnCheck.Column).EntireColumn.Hidden = True And _
Application.IfError(Application.Match(MyColumnCheck.Column, MyColumnArray, 0), 0) > 0 _
Then
MyColumnArray(Application.Match(MyColumnCheck.Column, MyColumnArray, 0) - 1) = -1
'... set that element of the MyColumnArray array to -1.
End If
Next
If WorksheetFunction.Sum(MyColumnArray) = 0 - (UBound(MyColumnArray) + 1) Then
Debug.Print "group MyColumnArray is hidden"
'execute code here for when the group is hidden
Else
Debug.Print "group MyColumnArray is visible"
'execute code here for when the group is visible
End If

Resources