I know this is a simple fix, but all my searching has not uncovered the answer. I need to create a dynamic hyperlink.
Sheet 1
Column A1 = 3/0/1
Column A2 = 3/0/2
Sheet 2
Column C3 = 3/0/1
Column D3 = 3/0/2
Now, creating a link on Sheet 2 to the appropriate cell in Sheet 1 is easy. Think is, Sheet 1 has the potential to be sorted in a variety of ways. So I need the link dynamic. I need it to find "3/0/1" whether it's in column A1 or A77, or whatever.
I've seen examples using the ADDRESS function within the HYPERLINK function, but can't get it to work. Any ideas?
This might actually be one of those time when you want to use .Selection to govern which cells the macro is enacted upon.
Sub hlink_Sel()
Dim fnd As Range, sel As Range
On Error Resume Next
With Sheets("Sheet1")
For Each sel In Selection
Set fnd = .Columns("A:A").Find(What:=sel.Text, After:=.Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not fnd Is Nothing Then
Debug.Print fnd.Address(0, 0, xlA1, external:=True)
.Hyperlinks.Add Anchor:=sel, Address:="", _
SubAddress:=fnd.Address(0, 0, xlA1, external:=True), TextToDisplay:=sel.Text
End If
Next sel
End With
Set fnd = Nothing
End Sub
Just select some cells that are supposed to have their values duplicated in Sheet1's column A and run the macro. Given the odd nature of your sample data, I've used .Text as the search term in the find operation. Note that the .Address function has the external parameter set to true in order that the worksheet name is included.
Related
So using VBA I'm trying to set the fillable fields in a form to an "allowed edit range"
Most fields on my form are merged so I can loop through get a selection and then select/deselect cells to the exact set I desire. So I get a result that looks like this
However the range definition looks like this $E$24:$G$24,$E$25:$G$25,$E$26:$G$26,$E$27:$G$27,$J$24:$L$24,$J$25:$L$25,$J$26:$L$26,$J$27:$L$27,$O$24:$Q$24,$O$25:$Q$25,$O$26:$Q$26,$O$27:$Q$27
As I have many more fields on this form this becomes an issue as the "allowed edit range" is only able to go up to 254 chars.
What I would like is a shorter range definition like this
E24:G27,J24:L27,O24:Q27
Then I can add that to an "allowed edit range"
Currently I'm iterating through each cell in the form and unioning any cell that is merged
Sub SelectMergedCells()
Dim scan_range As Range
Dim cell As Range
Dim merge_range As Range
Set scan_range = ActiveSheet.Range("B11:AM69")
For Each cell In scan_range
If cell.MergeCells Then
If merge_range Is Nothing Then
Set merge_range = cell
Else
Set merge_range = Union(merge_range, cell)
End If
End If
Next cell
merge_range.Select
End Sub
Is there a better way to select the cells? Is there a way to reduce my selection definition to something shorter? Or do I have to break up my definition into multiple 254 char chunks and add multiple ranges?
TIA
If I understand you correctly and if you don't mind using selection ... this is to answer this quote :
What I would like is a shorter range definition like this
so maybe you want to see the code below to help you get started....
The merge cells in a sheet is like this (please ignore the fill color as they are used to be easier to see the merge range).
Expected result :
F3:H3,H5:J6,F7:G7,A7:C8,I8:J11,E9:G11,A2:C4,F2:G2
So after I macro-recording my manual process then modified it a bit, the code is something like this :
Sub test()
Dim rg As Range: Dim c As Range: Dim rgU As Range
Application.ScreenUpdating = False
Set rg = Range("A1:J12"): rg(1, 1).Activate
'Set rg = Range("A1:N6"): rg(1, 1).Activate
With Application.FindFormat
.WrapText = False
.ShrinkToFit = False
.MergeCells = True
End With
Set c = rg.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True)
If Not c Is Nothing Then
fa = c.Address
Do
c.Select
If rgU Is Nothing Then _
Set rgU = Selection _
Else Set rgU = Union(rgU, Selection)
Set c = rg.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True)
Loop While c.Address <> fa
End If
Debug.Print Replace(rgU.Address, "$", "")
Application.FindFormat.Clear
End Sub
Debug print result is the same with the expected result:
F3:H3,H5:J6,F7:G7,A7:C8,I8:J11,E9:G11,A2:C4,F2:G2
Basically the sub is looping to a cell which is merged as c variable.
select the c, and create rgU variable as the union of rgU and the selection (not the c).
Test with a merge cell similar in your case :
the debug print result is like this :
A2:C5,F2:H5,K2:M5
As I have many more fields on this form this becomes an issue as the
"allowed edit range" is only able to go up to 254 chars.
just now I test the code which rg is A1:AQ75 (multiplying the existing merge cell). Although the rgU.select show a correct result, but I'm sorry, the debug.print rgU.address is only until cell R17.
So, even after this $E$24:$G$24,$E$25:$G$25,$E$26:$G$26,$E$27:$G$27 string is already shorten like this E24:G27, my code is still useless as I think it still won't be able to show the address until the last column and row of the merge cell if the range of the merge cells is too big (cell AQ75 in my case, cell AM69 in your case).
So it need a loop within rgU to get all the merge cell address :
for each cell in rgU.areas:debug.print cell.address:next
Then the last looped result is $AO$97:$AQ$75
btw, about allowed edit range, can't you just use your merge_range variable as reference without the need to have it's address?
I'm trying to filter on a column labeled "Date" across 10 worksheets. The column "Date" may not be in the same column position for every worksheet.
Is there a macro or code I can use to filter on the "Date" column in one easy button push? Instead of going to each individual worksheet and filtering separately..
I would only be filtering on the same date for all worksheets. For example, if I wanted to filter on "9/3/2021", I would go to each worksheet and find the "Date" column and manually filter 10 times.
if you add two simple cells to one of your sheets containing the header text and the value you want to filter you can use the below code to achieve the intended result.
for example my header named "Date" so in my first sheet I wrote "Date" in A3 and the date I want to filter into A4. just keep in mind that since we are searching for the "Date" header in first row either we should put our so called Criteria Range header in another row or since our search ends with first occurrence we can add the new header to one of the columns after our original Date column.
Note:
The Criteria Range table headers must be exactly like the target selection headers for this to work. so here I have one column and one header, and I only selected the Date column.
Sub Test()
Dim Rng As Range
For i = 1 To 4
With Sheets(i).Range("A1:Z1")
Set Rng = .Find(What:="Date", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'################################# New Part ▼
' R will be the address of the found column in Range format (e.g. "F1")
R = Rng.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Dim rgData As Range, rgCriteria As Range
' rgCriteria is the two cells Criteria Range
Set rgCriteria = Sheets(1).Range("A3:A4")
' these next two lines are adding the Date column range to rgData
LastRow = Sheets(i).Cells(Rows.Count, Rng.Column).End(xlUp).Row
Set rgData = Sheets(i).Range(Sheets(i).Range(R), Sheets(i).Cells(LastRow, Rng.Column))
' since I was disappointed in AutoFilter I used Advanced Filter and its even faster
rgData.AdvancedFilter xlFilterInPlace, rgCriteria
'################################# New Part ▲
Else
MsgBox "Nothing found"
End If
End With
Next i
End Sub
That's All!
References:
○ - Thanks to this Excel Macro Mastery channel video. make sure to watch it to get a better understanding of what I wrote.
you can find the "Date" column (which I presume there is a row contains the word "Date") by searching that row (e.g. first row of each sheet) for the word "Date". then you can give the column number to your filtration sub and get your filtering result.
1st Way
Sub Test()
For i = 1 To 10
For j = 1 To 50
If Worksheets(i).Cells(1, j).Value = "Date" Then
' here goes your filtration procedure on j column
Exit For
End If
Next j
Next i
End Sub
which i is the number of worksheets and j is the found column (in first 50 columns)
2nd Way (Faster Way)
Using Range.Find which suggested by #BigBen because:
Looping cell-by-cell is slow and inefficient
Sub Test()
Dim Rng As Range
For i = 1 To 5
With Sheets(i).Range("A1:Z1")
Set Rng = .Find(What:="Date", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
' here goes your filtration procedure on (Rng.Column)
Else
MsgBox "Nothing found"
End If
End With
Next i
End Sub
which i is the number of worksheets and Rng.Column is the found column (in A1:Z1 range)
References:
Microsoft Docs page for Range.Find method
there is another Microsoft Docs Page if you want
to use Application.Match method
I am trying to set values for variables to be used later on in my code based on the column value of a found cell.
Thanks to some existing subject, I was able to find the cell, but I am unable to set its column value to a name.
Here is my code:
Dim rFind As Range
With Range("A1:DD1")
Set rFind = .Find(What:="FIND", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
MsgBox rFind.Column
End With
End Sub
The MsgBox returns the correct column number but my attempts at getting it set to a name has failed.
Thanks for your help !
EDIT:
My goal is to create an automatic table with data extracted from another table. I want to use the column number to extract data for each row of my table from the correct column. I currently use a system where I "hardcode" my names for the current column number (e.g.: Publi Const example As Integer = 5). However this is not a flexible solution if my data table were to change (new or removed columns). Finding the column to then set it would solve the issue.
Perhaps this, to name the whole column?
rFind.EntireColumn.Name = "Fred"
Fuller code
Sub x()
Dim rFind As Range
With Range("A1:DD1")
Set rFind = .Find(What:="FIND", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
rFind.EntireColumn.Name = "Fred"
Else
msgbox "Not found"
End If
End With
End Sub
I have this snippet of code that I've borrowed from other post and edited(or at least tried) that I'm trying to use to subtotal some dynamic ranges. I use a key column with 0's, 1's, and 2's. I want the code to add all the coorosponding columns across from each 1 until it hits a 2 and then put the subtotal in the column with the 2. Currently, my code keeps running backwards so it is putting the wrong subtotals in. Below is a snippet of my code.
'count all 1's in each section till next 2 for subtotaling each section
With Range("P13:P" & lRow1)
Set rFind = .Find(What:=2, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
Lookat:=xlWhole, SearchDirection:=xlNext, searchFormat:=False)
If Not rFind Is Nothing Then
s = rFind.Address
Do
Set r1 = rFind
Set rFind = .FindNext(rFind)
If rFind.Address = s Then
Set rFind = .Cells(.Cells.Count)
r1.Offset(, -5).Value = Application.Sum(Range(r1.Offset(-1, -5), r1.Offset(, -5)))
Exit Sub
End If
r1.Offset(, -5).Value = Application.Sum(Range(r1.Offset(-1, -5), rFind.Offset(, -5)))
Loop While rFind.Address <> s
End If
End With
Even now that I type this question out I'm thinking I should take a different approach. My code places a 0 at each blank line and I currently have it set to place a 0 on the line above the 1st 1. With that, I could maybe find the 1st 0 then add all the 1's till i reach a 2 then find the next 0 and so forth. Does that make sense?
Below is a picture of what the macro is currently producing.
You can actually do this with a formula
=IF(P3=2,SUMIF($P$1:P2,1,$K$1:K2)-SUMIF($P$1:P2,2,$K$1:K2),"")
in each cell in K where there is a 2 in column P. Could use VBA to insert this.
Here's a straight VBA solution:
Sub x()
Dim r As Range
For Each r In Range("K:K").SpecialCells(xlCellTypeConstants).Areas
r(r.Count + 1).Value = Application.Sum(r)
Next r
End Sub
I have searched to find the answers to get to where I am but am now stuck! I am a relative beginner with VBA.
I have a Workbook that lists a few hundred orders that we are producing for our customer.
The order details are on the first sheet called "In Progress" and on the 3rd sheet called "StyleData" are more details about each product such as its composition, design reference, SKU etc...
At present my code searches column A on the Data sheet based on the 6 digit style code in the active cell on the In Progress Sheet, then goes to that cell. I have put a MsgBox in purely to put a pause in the code so I know where it has got to.
What I want it to do after finding the style code on the data sheet is return a value on the same row from column H, preferable in a format that the use can select and copy, then it will return to the original cell at the start of the macro.
Code as follows:
Sub get_composition()
Dim item_no As String
Dim data_sheet As Worksheet
Dim found_item As Range
Set Rng = ActiveCell
item_no = ActiveCell.Value
Set data_sheet = Sheets("StyleData")
If Trim(item_no) <> "" Then
With Sheets("StyleData").Range("A:A")
Set found_item = .Find(What:=item_no, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not found_item Is Nothing Then
Application.Goto found_item, True
Else
MsgBox "Nothing found"
End If
End With
End If
MsgBox "Return to Original Cell"
Application.Goto Rng
End Sub
if I understand what you want :
you arrive at cell "found_item" and want to return a value from the same row.
If it's so, you can use method Offset on "found_item"
found_item.Offset() allow you to navigate from the current range
https://msdn.microsoft.com/en-us/library/office/ff840060.aspx
If you are on column A, found_item.Offset(, 1) will return the range on the same line but column B