I have a Data table with an Auto Filter (shown Below).
Sub Tariff_Filter()
Dim columnNumber, tableRow, tableColumn, tableWidth As Integer
Dim tableName, columnName As String
tableName = "Tariff_Table"
columnName = ActiveSheet.Range("A1").Value
'This clears the existing filter
ActiveSheet.ListObjects(tableName).Range.AutoFilter
'Assign some numbers we need to know about the table to check the headers
tableRow = ActiveSheet.ListObjects(tableName).Range.Row
tableColumn = ActiveSheet.ListObjects(tableName).Range.Column
tableWidth = ActiveSheet.ListObjects(tableName).Range.Columns.Count
'If a column title with the specified value does not exist VBA throws an error which we need to catch
On Error GoTo ErrorHandler
'Search through the table column header row to find the specified column and assign the number to columnNumber
columnNumber = Application.WorksheetFunction.Match(columnName, Range(Cells(tableRow, tableColumn), Cells(tableRow, tableColumn + tableWidth)), 0)
'Apply the filter "1" to the found columnNumber
ActiveSheet.ListObjects(tableName).Range.AutoFilter field:=columnNumber, Criteria1:="1"
'Exit the sub otherwise the "error handling" will be provoked
Exit Sub
ErrorHandler:
MsgBox columnName & "Please Specify Required Channel"
End Sub
As i cant seem to figure out how to get my combo-box's to show only the visible cells after filtering the table i was wondering if there is a way i can create a a validation box to show the visible cells or copy the visible data into a seperate table underneath. I can then use the validation box/ secondary table as a focus point for the combo-box's on the user-form.
Thanks in advance
If I'm understanding your question correctly, you would like to have a data-validation drop-down list that updates as the table is filtered and only displays visible items for a given column.
You can do this by using the following formula in Data Validation (I'm assuming your table header row starts in A1 and it's col A you need to display):
=OFFSET($A$2,,,SUBTOTAL(103,TableName[column name]))
This formula expands from the starting cell (A2) by a specified height in number of rows. We are defining the height using SUBTOTAL with function number 103 - this means that the height is defined using COUNTA, but only on visible cells, so it will expand and collapse as the table is filtered.
Be aware: since the height is defined using a counta function, it will only count cells containing data, therefore if you have blanks in your table, the range will not be defined correctly. Also if you have any repeated data, these will be repeated in your drop-down box, this method will not condense them into a neat, unique list.
Hope this is helpful.
D
Related
I am new to VBA and am trying to delete unwanted columns loaded from a .csv file. I am importing a large amount of data but then I ask the user what columns they want to keep going by "ID num.". There are a lot of columns with different ID no. and I want to ask the user what they want to keep and delete the rest.
The problem is I need to delete all the other columns the user didn't want but I still need to keep the first 6 columns and the last two columns as that is different information.
Here is what I have so far:
Sub Select()
'the below will take the users inputs
UserValue = InputBox("Give the ID no. to keep seperating with a comma e.g"12,13,14")
'the below will pass the user inputs to the example to split the values
Call Example(UserValue)
End Sub
Sub Example(UserValue)
TestColArray() = Split(UserValue, ",")
For Each TestCol In TestColArray()
' keep all the columns user wants the delete the rest except the first 6 columns and last 2
Next TestCol
End Sub
That is what I have so far, it is not much but the user could put in a lot of columns with different ID number in the input box the way the Excel sheet is laid out all the ID no.s are in row 2 and the first 6 and last 2 columns are blank of row 2 since the ID no. does not apply. I hope that helps.
try this (commented) code:
Option Explicit '<--| use this statament: at the cost of having to declare all used variable, your code will be much easier to debug and maintainable
Sub MySelect()
Dim UserValue As String
'the below will take the users inputs
UserValue = Application.InputBox("Give the ID no. to keep seperating with a comma e.g: ""12,13,14""", Type:=2) '<--| use Type:=2 to force a string input
'the below will pass the user inputs to the example to split the values
Example UserValue '<--| syntax 'Call Example(UserValue)' is old
End Sub
Sub Example(UserValue As String)
Dim TestCol As Variant
Dim cellsToKeep As String
Dim firstIDRng As Range, lastIDRng As Range, IDRng As Range, f As Range
Set firstIDRng = Range("A2").End(xlToRight) '<-- first ID cell
Set lastIDRng = Cells(2, Columns.Count).End(xlToLeft) '<-- last ID cell
Set IDRng = Range(firstIDRng, lastIDRng) '<--| IDs range
cellsToKeep = firstIDRng.Offset(, -6).Resize(, 6).Address(False, False) & "," '<--| initialize cells-to-keep addresses list with the first six blank cells at the left of first ID
For Each TestCol In Split(Replace(UserValue, " ", ""), ",") '<--| loop through passed ID's
Set f = IDRng.Find(what:=TestCol, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<--| search for the current passed IDs range
If Not f Is Nothing Then cellsToKeep = cellsToKeep & f.Address(False, False) & "," '<--| if the current ID is found then update cells-to-keep addresses list
Next TestCol
cellsToKeep = cellsToKeep & lastIDRng.Offset(, 1).Resize(, 2).Address(False, False) '<--| finish cells-to-keep addresses list with the firts two blank cells at the right of last ID
Range(cellsToKeep).EntireColumn.Hidden = True '<-- hide columns-to-keep
ActiveSheet.UsedRange.EntireColumn.SpecialCells(xlCellTypeVisible).EntireColumn.Delete '<--| delete only visible rows
ActiveSheet.UsedRange.EntireColumn.Hidden = False '<-- unhide columns
End Sub
it's assumed to be working with currently active worksheet
A simple google search produces this. On the first page of results too. Perhaps this will suit your needs.
If the data set that needs to be deleted is really large (larger than the ranges you want to keep too.) Then perhaps only select the columns you want to have whilst you import the csv? This stackoverflow question shows how to import specific columns.
EDIT:
So from what I believe the OP is stating as the problem, there is a large csv file that is being imported into excel. After importing there is alot of redundant columns that should be deleted. My first thought would be to only import the needed data (columns) in the first place. This is possible via VBA by using the .TextToColumns method with the FieldInfo argument. As stated above, the stackoverflow question linked above provides a means of doing so.
If the selective importing is not an option, and you are still keen on making an inverse of the user selection. One option would be to create 2 ranges (one being the user selected Ranges and the second being the entire sheet), you could perform an intersect check between the two ranges and delete the range if there is no intersection present (ie. delete any cell that is not part of the users selection). This method is provided by the first link I supplied and is quite straight forward.
I'm running a macro in Word which, among other things, adds a line to the bottom of a table already existing in the document and fills certain cells. The odd thing is that for the majority of the documents it Works, however there are a couple of documents for which I receive the Run Time error 91.
'Update the document properties, updates the header, updates the table of contents,
' and adds a file to the Version History table.
Sub zzAddVersionHistory(strUsuario As String, strDescripcion As String)
Dim newDate As String
Dim rowNumber As Integer
Dim rowNew As Row
Dim strIssue As String
Dim ascIssue As Integer
'Updates the Date property
newDate = Format(Date, "dd/MM/yyyy")
ActiveDocument.CustomDocumentProperties("Date").Value = newDate
'Finds the version from the Issue property and updates the version
If DocPropertyExists("Issue") = True Then
strIssue = ActiveDocument.CustomDocumentProperties("Issue").Value
ascIssue = (Asc(strIssue)) + 1 'Convierte el Issue en ascii y le suma uno
strIssue = Chr(ascIssue) 'Convierte el ascii en caracter
ActiveDocument.CustomDocumentProperties("Issue").Value = strIssue
End If
'Updates Header and footer
zzActualizarHeaderFooter
'Updates Fields
zzActualizarCampos
'Accepts changes in header y footer
zzAcceptChangesInHeaderFooter
'Adds a row to the table
rowNumber = Application.ActiveDocument.Tables(1).Rows.Count
Set rowNew = Application.ActiveDocument.Tables(1).Rows.Add
'Inserts KTC Issue In first cell of the new row
rowNew.Cells(1).Range.InsertAfter (strIssue) ''' Runtime-error here
'Inserts Issued By in the third cell of the new row
rowNew.Cells(3).Range.InsertAfter (strUsuario)
'Inserts the Date in the fourth cell of the new row
rowNew.Cells(4).Range.InsertAfter (newDate)
'Inserts Description of Changes in the fifth cell of the new row
rowNew.Cells(5).Range.InsertAfter (strDescripcion)
'Updates the Table of Contents
zzActualizarIndices
End Sub
If needed I can provide the subs and functions called by the macro, but I don't think they have anything to do with the issue.
I believe the problem is somewhere in those documents, in the table format, but I could not find an explanation anywhere nor I can find any difference with the tables in other documents.
Nested tables mess up the cells collection. Once you manually merge/split cells on the last row and then add a new row, things become... different. Save as rtf, look at the code, and scratch your head.
Use one (the first? second?) "standard" row to count the columns and adjust the code in case the column count / cells count of the last row differs from that "norm". Use "Selection" and a breakpoint to investigate the troublesome table to learn how to handle these special cases.
In combobox I set columnCount to 3, so when I click dropdown arrow I can see 3 columns that I need, but when I choose one row that I need, there is only value from first column shown. Combobox is wide enough for all three columns. Is there a way to see all 3 when I select my choice?
You need to change the ListFillRange to all the columns in your list:
Sheet1!$A$5:C20
Also you need to have a single cell referenced in the LinkedCell property: Sheet1!$A$1
The bound column must be a value between 1 and 3. You can only return a single value from the list - this will be from the bound column.
Your column count must be 3.
Your column widths must be either blank or a value >0 (0 will hide the column):
85.05 pt;85.05 pt;85.05 pt
With those in place you should be seeing three columns of values in the list box - you can only return a value from one of those columns though.
If you want to return more than one I'd suggest using a hidden (column width of 0) column to contain a unique identifier and then use a look-up on the sheet to fill in the blank columns.
To get to all three columns in VBA use code similar to:
Private Sub ComboBox1_Change()
With Me.ComboBox1
MsgBox .Column(0) & vbCr & .Column(1) & vbCr & .Column(2)
End With
End Sub
The data I have can be simplified to this:
http://i.imgur.com/mn5GgrQ.png
In this example, I would like to delete the data associated with track 2, since it has only 3 frames associated with it. All data with more than 3 associated frames can stay.
The frame number does not always start from 1, as I've tried to demonstrate. The track number will always be the same number consecutively for as many frames as are tracked. I was thinking of using a function to append 1 to a variable for every consecutive value in column A, then performing a test to see if this value is equal >= 3. If so, then go onto the next integer in A, if no, then delete all rows marked with that integer (2, in this case).
Is this possible with Visual Basic in an Excel Macro, and can anyone give me some starting tips on what functions I might be able to use? Complete novice here. I haven't found anything similar for VBA, only for R.
I assume you understand the code by reading it.
Option Explicit
Public Function GetCountOfRowsForEachTrack(ByVal sourceColumn As Range) As _
Scripting.Dictionary
Dim cell As Range
Dim trackValue As String
Dim groupedData As Scripting.Dictionary
Set groupedData = New Scripting.Dictionary
For Each cell In sourceColumn
trackValue = cell.Value
If groupedData.Exists(trackValue) Then
groupedData(trackValue) = cell.Address(False, False) + "," + groupedData(trackValue)
Else
groupedData(trackValue) = cell.Address(False, False)
End If
Next
Set GetCountOfRowsForEachTrack = groupedData
End Function
Public Sub DeleteRowsWhereTrackLTE3()
Dim groupedData As Scripting.Dictionary
Set groupedData = GetCountOfRowsForEachTrack(Range("A2:A15"))
Dim cellsToBeDeleted As String
Dim item
For Each item In groupedData.Items
If UBound(Split(item, ",")) <= 2 Then
cellsToBeDeleted = item + IIf(cellsToBeDeleted <> "", "," + cellsToBeDeleted, "")
End If
Next
Range(cellsToBeDeleted).EntireRow.Delete
End Sub
GetCountOfRowsForEachTrack is a function returning a dictionary (which stores track number as key, cell address associated with that track as string)
DeleteRowsWhereTrackLTE3 is the procedure which uses GetCountOfRowsForEachTrack to get the aggregated info of Track numbers and cells associated with it. This method loops through the dictionary and checks if the number of cells associated with track is <=2 (because splitting the string returns an array which starts from 0). It builds a string of address of such cells and deletes it all at once towards the end.
Note:
Add the following code in a bas module (or a specific sheet where
you have the data).
Add reference to "Microsoft Scripting.Runtime" library. Inside VBA, click on "Tools" -> "References" menu. Tick the "Microsoft Scripting.Runtime" and click on OK.
I have used A2:A15 as an example. Please modify it as per your cell range.
The assumption is that you don't have thousands of cells to be deleted, in which case the method could fail.
Make a call to DeleteRowsWhereTrackLTE3 to remove such rows.
Sheet1 contains my data which also becomes my filtered data as i have set filter in place rather than copying the range.
The criteria range on the spreadsheet is populated by a UserForm command button, which also applies the advanced filter.
The criteria range of 2 of the columns within this filter are populated from a list box with the MultiSelectMulti function enabled.
I want to be able to select multiple items from these 2 lists boxes to filter for. I have tried the following and it populated the cells i assigned as it should. Although the filter i believe is trying to find all the values i have assigned in one row, not for each individually so there-fore not displaying anything.
I am pretty new at using VBA and have read some posts about using Unique:=True after the code for the criteria range. I don't know how to use this so if someone could explain that would be great.
'SEARCH CRITERIA - JOB STATUS
If ListBox1.Selected(0) = True Then Range("BK2") = "WON"
If ListBox1.Selected(1) = True Then Range("BL2") = "PENDING"
If ListBox1.Selected(2) = True Then Range("BM2") = "LOST"
'SEARCH CRITERIA - WIN PERCENTAGE
If ListBox2.Selected(0) = True Then Range("BN2").Value = "100%"
If ListBox2.Selected(1) = True Then Range("BO2").Value = "90%"
If ListBox2.Selected(2) = True Then Range("BP2").Value = "80%"
If ListBox2.Selected(3) = True Then Range("BQ2").Value = "70%"
If ListBox2.Selected(4) = True Then Range("BR2").Value = "60% OR LESS"
'APPLY ADVANCED FILTER USING SELECTED CRITERIA
Range("A6:BD99999").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("BH1:BR2")
'BH1:BJ2 CONTAINS MY OTHER CRITERIA
I already have the sheet set to unprotect prior the code and after the code (as well as my other selections on the user form which work fine). I have tried using 'OR' and 'Else:' to no avail.
Any suggestions would be greatly appreciated on how i can solve my issue to filter the above when selecting multiple items without me having to create extra columns for each criteria in the data as i will have to move loads of conditional formatting manually and it will create too much clutter on my already large sheet.
in short, the AdvancedFilter filtering criteria requires to:
spread filter values between rows to achieve some "OR" condition
keep filter values in the same row to achieve some "AND" condition
Not so sure about your actual filtering needs, but my first guess is that you need something like follows (explanations in comments, and I'm assuming that filtering criteria are contained in listboxes items themselves):
Option Explicit
Private Sub CommandButton1_Click()
Dim iSel As Long, iRow As Long
Intersect(Range("BH1:BR1").EntireColumn, ActiveSheet.UsedRange).Offset(1).ClearContents ' clear any existing filtering criteria
With ListBox1 'reference ListBox1
For iSel = 0 To 2 'loop through its items from first to third (note you can use 'For iSel = 0 To .Count-1' to loop through all its items)
If .Selected(iSel) Then ' if current item is selected
iRow = iRow + 1 'update filter range row to achieve "OR" condition
Cells(1 + iRow, "BK") = .List(iSel) 'write current referenced listbox value in criteria range cell in a row by its own
End If
Next
End With
With ListBox2
For iSel = 0 To 4
If .Selected(iSel) Then
iRow = iRow + 1
Cells(1 + iRow, "BN") = .List(iSel)
End If
Next
End With
Range("A6:BD99999").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("BH1:BR1").Resize(iRow + 1) ' size criteria range to fit the filtering values read from listboxes
End Sub
in such a way you filter A:BD rows that match any filter value between those selected in the two listboxes, i.e. filtered record will have:
any selected value from ListBox1 in column referenced by "BH1" cell value
or
any selected value from ListBox2 in column referenced by "BN1" cell value
should that be what you need, than you can remove columns BL to BM and BO to BR from criteria range (and therefore adjust all BN references to BL)
finally I'd recommend you to use explicit worksheet reference instead of implicitly relying (as your code currently does) on the ActiveSheet