Please I need help implementing multiple dynamic dropboxes in Excel:
On sheet 1 there is a filled table
On sheet 2 there is an empty table with the same column headers
On sheet 2 the table is filled by the user with the exception of the last column
On sheet 2 in the last column there should be a dropbox in each row. This dropbox must contain a selection of values from the same column in table 1. The selection should consider only rows in table 1 matching fields already filled in the table 2 row where the dropbox resides. See example below.
The whole thing should require no additional user interaction and should also allow inserting arbitrary values in addition to those of the dropbox.
Example
TABLE 1
BRAND | CPU | MODEL
brand1 | cpu1 | modelX
brand1 | cpu1 | modelY
brand1 | cpu2 | modelZ
brand2 | cpu2 | modelH
brand2 | cpu2 | modelK
TABLE 2
BRAND | CPU | MODEL
brand1 | cpu1 | [DROPBOX1]
brand2 | cpu2 | [DROPBOX2]
EXPLANATION
[DROPBOX1] should contain modelX and modelY
[DROPBOX2] should contian modelH and modelK
I managed to create one such dropbox through a named range within a dedcated table, but that's it. I cannot employ the same system for an arbitrary number of rows.
The whole thing screams Access, but implementation details came from above so Excel it is (thank you management).
Thanks.
I'm having a little trouble following you, but it appears that a quick setup for this to toy with would be with data Validation on the Data Tab.
Select Data Validation from Data Tab
Select Data Validation
Select from Allow: "List"
Under source, there are 2 ways to proceed...
you can highlight the column range you would like to see on the droplist.
You can highlight the column range, on the top left where the Column/Row name is, highlight and rename, and use that name as the source.
I will typically create an additional tab, hide/protect it, then create my drop down sheets from there.
I had the privilege of receiving support on Microsoft forums from the first EU MVP, Mr. Bill Manville.
This is the macro which solved the problem:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iCol as Integer
Dim rTable1 As Range
If Target.Cells.Count<>1 Then Exit Sub
Set rTable1=ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion
With Me.Range("A1").CurrentRegion
If Target.Column<>.Columns.Count Then Exit Sub
rTable1.AutoFilter
For iCol = 1 To .Columns.Count-1
rTable1.AutoFilter iCol, Me.Cells(Target.Row, iCol)
Next
If rTable1.Columns(1).SpecialCells(xlVisible).Count>1 Then
rTable1.Columns(.Columns.Count).Offset(1).Resize(rTable1.Rows.Count-1).SpecialCells(xlVisible).Name = "ValidationList"
Else
MsgBox "The combination in this row is not matched"
End If
rTable1.AutoFilter
End With
End Sub
He was also so kind as to provide a working example
For these to work the source table must be ordered, as data validation would only consider the first section of a named range split in multiple sections.
Related
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.
Situation:
I am using a PivotTableUpdate event to clear a range to the right of a PivotTable and then insert values, in the next available column, to the right of the PivotTable.DataBodyRange.
Single slicer item selection:
In the first image below, I am selecting one slicer item and then using
.Offset(, .Columns.Count).Resize(.Rows.Count, 25)
to clear a region to the right of the DataBodyRange. The Resize is to account for prior selections which may have populated a different column from the currently next available.
I am then using
.Offset(, .Columns.Count).Resize(.Rows.Count, 1) = "1"
to set the next available free column's value to, in this case, 1.
Example: One slicer item selection, table and pivot in Sheet1:
So I am going from "before" to "after" as shown below:
This works fine. There is no change in the next available column address.
Multi-item slicer selection:
When I attempt the same thing with a multi-select the code halts with the standard "Alert before overwriting cells" i.e. I get:
There is already data in..Do you want to replace it?
Example: Multi slicer item selection, table and pivot in Sheet1:
What I have tried:
Application.DisplayAlerts = False
And
Application.AlertBeforeOverwriting = False
And (to clear the pop-up)
Application.SendKeys "{ENTER}"
The message still appears for multi-select and doesn't go away until I manually press the OK
Thoughts:
I had thought perhaps the message is triggered before the event code is run, but I don't get this message when I overwrite the same range (i.e. single slicer item selection)
I know you can manually switch this alert off via the File > Options > Advanced Settings but am unsure how to suppress, via code, in my current code.
Anyone have a solution on how to suppress this alert?
Code:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Application.DisplayAlerts = False
With Target.DataBodyRange
Dim clearRange As Range
Set clearRange = .Offset(, .Columns.Count).Resize(.Rows.Count, 25)
clearRange.ClearContents
.Offset(, .Columns.Count).Resize(.Rows.Count, 1) = "1"
End With
Application.DisplayAlerts = True
End Sub
Test data:
| Trust | STP | Val |
|-------|------|-----|
| A | STPa | 1 |
| B | STPb | 2 |
| C | STPc | 3 |
References:
Suppress Overwrite Existing Data Alert In VBA Macro
Prevent Overwrite Warning in VBA
As noted, by the time the event has fired it is too late.
My hack around was to create a public variable holding the pvt.ColumnRange.Columns.Count where the pvt is a hidden duplicate pivottable (of the one in question) that has all the possible selection items in the columns. Then doing a plus 1 on this to set the start area for adding data i.e. no overlap can occur. This was set in an Init procedure so is available before the event is triggered.
My situation is the following: I have a table in which there are codes of working shifts i.e. :
John | 1 | 34 | 1 | 34 | Total: | 40 <----
Maria| 1 | 1 | 1 | 1 | Total: | 32 <----I need a formula for this last cell
Every one of this codes has hours amount set in another table.
Codes | Hours
1 | 8
34 | 12
I need to calculate the total amount of work hours based on the codes. I have found ways to map the values to the other table with INDEX and MATCH but when I try to do it for a lot of rows it just gives me the first code mapped, not an array with the mapped values.
I think what will help is the following custom VBA function(see example below). Use as follows:
=multipleMatch(range of cells to look in, range of cells to INDEX, range of cells to MATCH)
Let me know if you have any questions.
Function multipleMatch(inputRng As Range, indexRng As Range, matchRng As Range) As Double
On Error GoTo errhandle
Dim runTot As Double
runTot = 0
Dim cll As Range
Dim mtch As Long
For Each cll In inputRng
If Not IsError(cll.Value) Then
On Error Resume Next
mtch = Application.WorksheetFunction.Match(cll.Value, matchRng, 0)
On Error GoTo errhandle
If mtch <> 0 Then
runTot = indexRng(mtch) + runTot
End If
End If
mtch = 0
Next cll
multipleMatch = runTot
Exit Function
errhandle:
multipleMatch = CVErr(xlErrValue)
Exit Function
End Function
Is there a reason why you have upper table going to the right?
Is there more than John in it?
If the upper table is the record of actually worked shifts, and the bottom one is the default working hours by shift code, and you plan on having more people, then i could suggest the following solution that will also re-organises your tables a little bit, and utilises Excel tables which will allow you to avoid having to maintain the formulas and ranges:
select your Bottom table range, press Ctrl+t which will turn it into
a blue table.
Rename columns just for this example to work - you can rename after you're done with steps here.
your "upper" table gets transposed, having 3 columns Name, Shift Code, Hours.
Do the same thing with it: select range, press ctrl+t, tick "Table has Headers" in the pop-up window. Rename columns as in picture.
in the 1st cell of Hours Column of table 2 (as in picture), paste this formula and hit Enter. (Now is a good time to change column names to your preference)
=SUMIF(Table1[Shift Code],[#[Shift Code]], Table1[Default Hours])
Create a pivot table of Table #2 next to it or wherever you ened it.
If you add data to tables 1 and 2, formulas will update automatically in table 2, and pivot table source. Refresh pivot table to see updated totals.
this is what it would look like.
I hope this is what you tried to achieve.
and if you want, you can put Shift Code into Columns area of pivot table as in the picture below, and have it broken down by code as well as a grandtotal:
*****P.S. Please remember to mark the most useful answer as "Answer" and vote up if other answers or comments were helpful*****
I have a dataset with 60+ thousand rows in excel and about 20 columns. The "ID column" sometimes repeats itself and I want to add a column that will return 1 only in the row that is the most recent only IF it repeats itself.
Here is the example. I have…
ID DATE ColumnX
AS1 Jan-2013 DATA
AS2 Feb-2013 DATA
AS3 Jan-2013 DATA
AS4 Dec-2013 DATA
AS2 Dec-2013 DATA
I want…
ID DATE ColumnX New Column
AS1 Jan-2013 DATA 1
AS2 Feb-2013 DATA 0
AS3 Jan-2013 DATA 1
AS4 Dec-2013 DATA 1
AS2 Dec-2013 DATA 1
I've been trying with a combination of sort and nested if's, but it depends on my data being always in the same order (so that it looks up the ID in the previous row).
Bonus points: consider my dataset if fairly large for excel, so the most efficient code that won't eat up processor would be appreciated!
An approach you could use is to point MSQuery at your table and use SQL to apply the business rules. On the positive side, this runs very quickly (a couple seconds in my tests against 64k rows). A huge minus is the query engine does not seem to support Excel tables exceeding 64k rows, but there might be ways to work around this. Regardless, I offer the solution in case it gives you some ideas.
To set up first give your data set a named range. I called it MYTABLE. Save. Next select a cell to the right of your table in row 1, and click through Data | From other sources | from Microsoft Query. Choose Excel Files* | OK, browse for your file. The Query Wiz should open, showing MYTABLE available, add all the columns. Click Cancel (really), and click Yes, you want to continue editing.
The MSQuery interface should open, click the SQL button and replace the code with the following. You will need to edit some specifics, such as the file path. (Also, note I used different column names. This was sheer paranoia on my part. The Jet engine is very finicky and I wanted to rule out conflicts with reserved words as I built this.)
SELECT
MYTABLE.ID_X,
MYTABLE.DATE_X,
MYTABLE.COLUMN_X,
IIF(MAXDATES.ID_x IS NULL,0,1) * IIF(DUPTABLE.ID_X IS NULL,0,1) AS NEW_DATA
FROM ((`C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE
LEFT OUTER JOIN (
SELECT MYTABLE1.ID_X, MAX(MYTABLE1.DATE_X) AS MAXDATE
FROM `C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE1
GROUP BY MYTABLE1.ID_X
) AS MAXDATES
ON MYTABLE.ID_X = MAXDATES.ID_X
AND MYTABLE.DATE_X = MAXDATES.MAXDATE)
LEFT OUTER JOIN (
SELECT MYTABLE2.ID_X
FROM `C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE2
GROUP BY MYTABLE2.ID_X
HAVING COUNT(1) > 1
) AS DUPTABLE
ON MYTABLE.ID_X = DUPTABLE.ID_X)
With the code in place MSQuery will complain the query can't be represented graphically. It's OK. The query will execute -- it might take longer than expected to run at this stage. I'm not sure why, but it should run much faster on subsequent refreshes. Once results return, File | Return data to Excel. Accept the defaults on the Import Data dialog.
That's the technique. To refresh the query against new data simply Data | Refresh. If you need to tweak the query you can get back to it though Excel via Data | Connections | Properties | Definition tab.
The code I provided returns your original data plus the NEW_DATA column, which has value 1 if the ID is duplicated and the date is the maximum date for that ID, otherwise 0. This code will not sort out ties if an ID's maximum date is on several rows. All such rows will be tagged 1.
Edit: The code is easily modified to ignore the duplication logic and show most recent row for all IDs. Simply change the last bit of the SELECT clause to read
IIF(MAXDATES.ID_x IS NULL,0,1) AS NEW_DATA
In that case, you could also remove the final LEFT JOIN with alias DUPTABLE.
Sort by ID, then by DATE (ascending). Define entries in new column to be 1 if previous row has the same ID and next row has a different ID or is empty (for last row), 0 otherwise.
It could be done in VBA. I'd be interested to know if this is possible just using formulas, I had to do something similar once before.
Sub Macro1()
Dim rowCount As Long
Sheets("Sheet1").Activate
rowCount = Cells(Rows.Count, 1).End(xlUp).Row
Columns("A:D").Select
Selection.AutoFilter
Range("D2:D" & rowCount).Select
Selection.ClearContents
Columns("A:D").Select
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("B1:B" & rowCount), SortOn:=xlSortOnValues
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("A1:A" & rowCount), SortOn:=xlSortOnValues
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.Apply
Dim counter As Integer
For counter = 2 To rowCount
Cells(counter, 4) = 1
If Cells(counter, 1) = Cells(counter + 1, 1) Then Cells(counter, 4) = 0
Next counter
End Sub
So you activate the sheet and get the count of rows.
Then select and autofilter the results, and clear out Column D which has the 0s or 1s. Then filter on the values mbroshi suggested that you say you're already using. Then execute a loop for each record, changing the value to 1, but then back to 0 if the value ahead of it has the same ID.
Depending on your processor I dont think this would take more than a minute or two to run. If you do find something using formulas I would be interested to see it!
We are generating long Excel sheets using various tools, which have to be reviewed and used as input further down in the workflow.
The problem that some cells are too small for texts they contain.
So humans and programs that are reading the worksheets will not see the same data.
This is usually true for merged cells containing auto-wrapped texts, when Excel does not adjust the row height properly. But there are also other cases: for instance, when some columns have width explicitly set, which is not enough for long values.
|Group|Def1 |Subgroup|Definition| Id |Data |Comment |
|-------------------------------------------------------|
| G1 | | G1-1 |Important |G1-1-1|... | |
| |Long | |about G1-1|G1-1-2|.....|........ |
| |text |-------------------------------------------|
| |about| G1-2 |Another |G1-2-1|... | |
| |group| |important |G1-2-2|... |long comme|
| |G1. | |text about|G1-2-3| | |
|-------------------------------------------------------|
Here, some cells in "Definition" and "Comment" are not fully visible.
Is there any method to find such cells programmatically?
To detect these cells (I'm not talking about fixing the problem), you could use the Text method of a Range object.
For example, Range("A1").Value might be 123456789, but if it's formatted as Number and the column is not wide enough, Range("A1").Text will be "###" (or however many # signs fit in the cell).
Here's a trick I've used before:
With Columns("B:B")
oldWidth = .ColumnWidth ' Save original width
.EntireColumn.AutoFit
fitWidth = .ColumnWidth ' Get width required to fit entire text
.ColumnWidth = oldWidth ' Restore original width
If oldWidth < fitWidth Then
' Text is too wide for column.
' Do stuff.
End If
End With
Of course this will apply to an entire column at a time. You can still use this by copying cells over one by one to a dummy column and do the AutoFit test there.
But probably more useful to you is an earlier answer of mine to this question: Split text across multiple rows according to column width. It describes a method to determine the width of the text in any given cell (and compare it to the cell's actual width to determine whether the text fits or not).
EDIT Responding to your comment: If some of your cells are tall enough to show 2 or more lines of text, then you can use a similar approach as described in my previous answer, first using .EntireRow.AutoFit to determine the height of the font and .RowHeight to determine how many lines fit in the cell, then figuring out whether the text can fit in that number of lines in a cell of that width, using the method of the previous question.
Unmerge all cells in the workbook and use
Thisworkbook.sheets("Name").rows(index).entirerow.autofit
And the same for columns.
What's the use of keeping the merged cells anyway except for esthetic reasons?
Only the value of the "base cell" is taken into account (upper left).
I bumped into the same problem today. I am trying this trick to dodge it. Perhaps, it might be useful for you. It is coded to deal with one column width merging areas:
'Sheet2 is just merely support tool no data sheet in ThisWorkbook
With Sheet2.Range(target.Address)
target.Copy
.PasteSpecial xlPasteAll
.UnMerge
If .MergeArea.Count > 1 Then .UnMerge
.ColumnWidth = target.ColumnWidth
.Value = target.Value
.EntireRow.AutoFit
target.MergeArea.EntireRow.RowHeight = _
1.05 * .RowHeight / target.MergeArea.Rows.Count
.ClearContents
.ClearFormats
End With
Unfortunately, if there are several columns with merged cells like this, perhaps their mutual needed height will collide with each other and extra code will be needed for restoring harmony. Looks like an interesting piece of code.
Wish you find this helpful.