Clicking a hyperlink in Excel to set an auto filter on a different sheet - vba

I have a detailed product order worksheet example table 2. and a summary worksheet supplier name and total value example Table 2.
I want to know is it possible when I click the hyperlink details will filter my detailed product order sheet under this supplier all order example table 3.
If anyone can do this for me it will be helpful for me
Table 1
Table 2
Table 3

You can use the Worksheet_FollowHyperlink event to detect when a hyperlink has been pressed. A hyperlink to a location within the document will have a SubAddress, and the text that you clicked on will be the TextToDisplay.
The following code will detect when you click a hyperlink to a worksheet and - if that worksheet has an autofilter - will filter the first column of the AutoFilter for the text that you clicked on.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim wsToFilter As Worksheet
On Error GoTo SubErr
If Right(Target.SubAddress, 3) = "!A1" Then 'Hyperlink is to a worksheet within this document
Set wsToFilter = ThisWorkbook.Worksheets(Replace(Target.SubAddress, "!A1", ""))
If wsToFilter.AutoFilterMode Then 'Hyperlink has an AutoFilter
wsToFilter.AutoFilter.ShowAllData 'Remove existing filters
wsToFilter.AutoFilter.Range.AutoFilter 1, Target.TextToDisplay 'Filter the First column for the text of the hyperlink
End If
Set wsToFilter = Nothing
End If
SubErr:
End Sub

Use the Worksheet.FollowHyperlink Event to filter the desired data.
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
MsgBox Cells(Target.Parent.Row, "A") 'returns the value of column A of the clicked link
'do your filter stuff here …
End Sub

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.

Userform listbox that depends on another listbox

I have been looking in the internet for the answer to this, but mostly people say to use data validation, which doesn't really solve my problem. What I'm trying to do is, lets say that I have ListBox1, which has 3 values (red, blue, green) and there's another listbox (ListBox2) where I want value of a list from a worksheet to appear depending on the answer of the first ListBox. For example: I select red from listbox1 and then I want to have the options from the list "red" (apple, coke,fire) in listbox2.
I would greatly appreciate some help in this. Thanks
you could use something like follows (adapt it as per your needs):
Private Sub ListBox1_Click()
With Me.ListBox2
.Clear
.List = Application.Transpose(GetColorItemsRange(Me.ListBox1.value)) 'fill referenced listbox with values from the range returned by GetColorItemsRange function
End With
End Sub
Function GetColorItemsRange(colorValue As String) As Range
With Worksheets("ColorItames") ' change "ColorItames" with actual name of your worksheet with items associated to colors
With .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)).Find(what:=colorValue, LookIn:=xlValues, lookat:=xlWhole) 'find and reference the referenced sheet row 1 cell matching the passed value
Set GetColorItemsRange = .Parent.Range(.Cells.Offset(1), .Cells.End(xlDown)) 'return the range ranging from referenced range down to last not empty cell before first empty cell
End With
End With
End Function
Data validation is the way to go. You would want to leverage some combination of VBA to adjust the range listbox2 is using after Listbox1 is updated. This is relatively easy if only 1 selection is used on listbox1.
Hopefully you just have one selection, so you could do the following code:
Private Sub ListBox1_Click()
If ListBox1.Selected(0) = True Then
'Selection is apple. Adjust DynamicRange name for A1:A3
ThisWorkbook.Names("DynamicRange").RefersTo = Range("A1:A3")
ElseIf ListBox1.Selected(1) = True Then
ThisWorkbook.Names("DynamicRange").RefersTo = Range("B1:B3")
ElseIf ListBox1.Selected(2) = True Then
ThisWorkbook.Names("DynamicRange").RefersTo = Range("C1:C3")
End If
End Sub
This is based on a setup that looks like this:
Here's what both listbox properties would look like:
If you want to download this classy template, click here.

Finding multiple criteria with VBA

i have a user form has 2 textboxes named "date" and "shift" and button to trigger a code. also a have a excel file named data.xlsx has "sheet1" have A column dates added as 07/02/2017, B column shift added as A/B/C.
date.value = "07/02/2017"
shift.value = "C"
so what i want to do is to find the row number of A column contains "07/02/2017" and B column contains "C" in data.xlsx.
Try the code below to find the Shift row in Column B (using the Match function).
You should be able to make the modifications to make it work also for finding the date from date TextBox.
Code
Sub CommandButton1_Click()
' this code goes inside the command button (inside the User_Form module)
Dim ValToSearch
Dim MatchRes As Variant
ValToSearch = Me.shift.Value '<-- get the value to look for
With Worksheets("Sheet1")
MatchRes = Application.Match(ValToSearch, .Range("B:B"), 0)
If IsError(MatchRes) Then '<-- match not found
MsgBox "Not found"
Else
MsgBox "Found at row " & MatchRes
End If
End With
End Sub

Populating a dropdown box with already-existing options in VBA?

I'm making an add records form for a spreadsheet of mine, and let's say that I want one of the controls to be a dropdown that is populated by unique entries under a certain column "type". However, I want to also make it such that the dropbox always has a initial option to "add new type" and upon such selection, it becomes a regular text box. How would I do this in VBA?
You cannot change a control type at run time. The easiest thing to do is create a combo box and a text box. Set the text box visibility to false. Then in the onchange event of the combo box your code will unhide the text box and hide the combo box. You will also need a save button so that when it is clicked it will add the option to the drop down, clear the text box, hide the text box, hide the button and unhide the drop down.
Okay, so here's my idea of how to tackle this.
Create 2 hidden elements (Visibility = False), one a TextBox and one a CommandButton.
Populate your ComboBox with the values from the sheet under column "type"
Add one more entry AddItem with wording such as "Add new item..."
When the user selects "Add new item...", change the Visibility of the TextBox & CommandButtons to True
When the user clicks the CommandButton, add the phrase to the column and add a new element to the ComboBox
I have created a mockup UserForm and code that does a little more than just this; it also styles the user entry to sentence case (consistency purposes) and checks to make sure the value isn't already in the column.
Excel Sheet with "type" column
UserForm with name labels
UserForm Code
Private Sub bAdd_Click()
Dim str As String
Dim rng As Range
Dim ro As Integer
'Makes sure there is an entry, adds it to the Sheet and then updates the dropdown
If Len(Me.tbNew) > 0 Then
'Converts user entry to "Sentance Case" for better readability
str = StrConv(Me.tbNew, vbProperCase)
'Finds out if the entry already exists
Set rng = Sheets(1).Range(Sheets(1).Cells(2, 1), Sheets(1).Cells(Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row, 1))
On Error Resume Next
Err.Number = 0
'Searches for duplicate; if found, then ListIndex of cbColor is modified without inserting new value (prevents duplicates)
ro = rng.Find(str, LookIn:=xlValues, LookAt:=xlWhole).Row
Debug.Print Err.Number
'Ensures a user doesn't add the same value twice
If Err.Number > 0 Then
Sheets(1).Cells(Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row + 1, 1) = str
Me.cbColor.AddItem StrConv(Me.tbNew, vbProperCase), Me.cbColor.ListCount - 1
Me.cbColor.ListIndex = Me.cbColor.ListCount - 2
Else
Me.cbColor.ListIndex = ro - 2
End If
'Resets and hides user form entries
Me.tbNew = vbNullString
Me.tbNew.Visible = False
Me.bAdd.Visible = False
End If
End Sub
Private Sub bClose_Click()
Unload Me
End Sub
Private Sub cbColor_Change()
'Visibility is toggled based on if the user selected the last element in the dropdown
Me.bAdd.Visible = Me.cbColor.ListIndex = Me.cbColor.ListCount - 1
Me.tbNew.Visible = Me.cbColor.ListIndex = Me.cbColor.ListCount - 1
End Sub
Private Sub UserForm_Initialize()
'Populate from the sheet
For a = 2 To Sheets(1).Cells(Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row, 1).Row
Me.cbColor.AddItem Sheets(1).Cells(a, 1)
Next
'Add option for new type
Me.cbColor.AddItem "Add new type..."
End Sub

How to collect data from multiple sheets by using sheet names

Thanks for the response!
however the code which you sent started from the beginning of the workbook. but it should not be.
For example, a workbook contains sheets (only user knows the sheet name, so we can't give the sheet name on the code) as following
Summary/Version/AA/BB/CC/DD/Final
If beginsheet=AA then the code should start collecting data from AA and if endsheet = DD then the code should stop collecting data at Final. Only till DD is valid.
So how can we achieve this.
You can do a FOR - EACH: For each theSheets in ActiveWorkbook.Sheets
For each theSheets in ActiveWorkbook.Sheets
Sheets(theSheets.Name).Select
msgbox(theSheets.Name)
next
I put the MSGBOX just to show the name of the sheet. Also the Select is not necessary I put it there just to show how it changes from sheet to sheet.
If you don't want to search all sheets (each sheet) but a specified number of sheets, you can assign the sheets names to a collection and the iterate that collection; in that case you have to know the names of the sheets.
sorry I did not get your first question...
Well, I don't know how practical this solution will be for you purpose but you could do the following:
When you open the workbook create CheckBoxes with the names of the Sheets:
Private Sub Workbook_Open()
Dim row As Integer
row = 14
For Each mysheets In ActiveWorkbook.Sheets
ActiveSheet.CheckBoxes.Add(20, row, 50, 20).Select
With Selection
.Caption = mysheets.Name
.Value = xlOff
.LinkedCell = "C" & ToRow
.Display3DShading = False
End With
row = row + 50
Next
End Sub
Have the users select the Sheets that apply.
Fill a collection with the "Text" of the selected CheckBoxes (which will be the names of the sheets)
Iterate through the sheets in the collection
Dim allSelectedSheets As New Collection
Public Sub FindSelectedCkBox()
For Each ckbox In ActiveSheet.CheckBoxes
If ckbox.Value > 0 Then
allSelectedSheets.Add ckbox.Text
End If
Next
iterateThroughSheets
End Sub
Sub iterateThroughSheets()
For Each theSheets In allSelectedSheets
ActiveWorkbook.Sheets(theSheets).Select
Next
End Sub
Make sure to remove the CheckBoxes when opening the Book so you don't end up with duplicates.