I've got a lot of hyperlinks and I want to assign a macros to each of them and Worksheet_FollowHyperlink captures only Inserted Hyperlinks but not the HYPERLINK() function. So I want my Inserted Hyperlinks refer to nothing so when I press them nothing happens. Or I want them to refer themselves. But when I just copy one to another cell it still refers to its parents cell. So I have to edit a new one so it refers to its new cell. And I've got hundreeds of hyperlinks to be copied and edited as well. I need that because I don't want the hyperlinks skip me to the parent hyperlink's cell.
Thanks in advance
You will be better off using the HYPERLINK() function. You can use it for what you want like this:
=HYPERLINK("#HyperlinkClick()", "Text you want to Display")
Notice the # at the beginning. This is important.
Now create a function called HyperlinkClick:
Function HyperlinkClick()
Set HyperlinkClick = Selection
'Do whatever you like here...
MsgBox "You clicked on cell " & Selection.Address(0, 0)
End Function
Be sure to place this function in a STANDARD CODE MODULE.
That's it.
I've just founded a solution. If I refer my Inserted Hyperlink to some cell in other sheet and then make it very hidden (xlSheetVeryHidden), it works just perfect. Now my hyperlinks refer to the Neverland and the macro captures them as well. Thank you all for your patiense.
Good solution Excel Hero but not for everything: I try to make a kind of outline but it's impossible to hide a row in the function: nothing happen! But if a make a direct call to the same code with a button, everything works fine. This is my test:
Function test()
Set test = Selection
Dim i, j, state As Integer
state = Selection.Value
i = Selection.Row + 1
j = i
If state = "6" Then
Do Until ActiveSheet.Cells(j, 7).Value = 1 Or ActiveSheet.Cells(j, 4).Value = ""
j = j + 1
Loop
ActiveSheet.Rows(i & ":" & j - 1).EntireRow.Hidden = True
Debug.Print "test group: " & i & ":" & j - 1
Else
Do Until ActiveSheet.Cells(j, 7).Value = 1 Or ActiveSheet.Cells(j, 4).Value = ""
j = j + 1
Loop
ActiveSheet.Rows(i & ":" & j - 1).EntireRow.Hidden = False
Debug.Print "test ungroup: " & i & ":" & j - 1
End If
End Function
My debug.print give me this:
test group: 4:26
Select a group of cells and run:
Sub HyperAdder()
For Each r In Selection
ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:=r.Parent.Name & "!" & r.Address(0, 0), TextToDisplay:="myself"
Next r
End Sub
Related
I am trying to figure out how to make a named range, based on a cell found using:
For Each Cell In ISBN_Range
If Cell.Value = ISBN Then
ISBN_Valid = True
ISBN_Found = Range("A" & Cell.RowIndex & ":E" & Cell.RowIndex)
ISBN_Found.Interior.ColorIndex = 6
Exit For
End If
Next Cell
This is not working, and I am not sure why, I haven't been able to find the answer elsewhere, sorry if this is really simple! I basically just want to make the row of data that the found cell exists in a named range. ISBN_Found is declared as a range much earlier in my code, so that is not the issue.
I figured out the answer with some help from the guys in the comments, final code looks like this:
For Each Cell In ISBN_Range
If Cell.Value = ISBN Then
ISBN_Valid = True
Set ISBN_Found = Range("A" & Cell.Row & ":E" & Cell.Row)
ISBN_Found.Interior.ColorIndex = 6
Exit For
End If
Next Cell
Just needed to delete "Index" from "Cell.RowIndex"
I'm trying to make a function to do the following:
Cycle through all my datasets in my sheet
Cycle through each column in my datasets
Look at the title for that column and check if it is in my list.
Find find a few various other columns, but this time using .Find
Now cycle through each row in the column for that specific dataset
Use the column references found in point 4 and the row from point 5 to put the cell's into a variable that will be used on step 7 which is to insert a formatted comment in the originally found column (for that row).
I've tried getting some code working from what I found on a different site but I can't get it working correct, I'm stuck at part 5.
A data example could look like:
My attempted code looks like:
Sub ComTest()
COMLIST = ";Cond;"
Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each a In rng.SpecialCells(xlCellTypeConstants).Areas
With a.CurrentRegion
Set r = .Rows(1)
For j = 1 To r.Columns.Count
TitleCell = r.Cells(j).Address
v = ";" & Range(TitleCell).Value & ";"
'-----------------------------------------------------------------------------------------
If InStr(1, COMLIST, v) Then
On Error Resume Next
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Condw = r.Columns.Find(Replace(v, ";", "") & " " & "w", lookAt:=xlWhole).Column
Condw = .Cells(r, Condw).Address
' Add more stuff here
End If
'-----------------------------------------------------------------------------------------
Next j
End With
Next a
End Sub
As for part 7, the output would essentially be as follows for "row 1" but this part I should be able to do, it's the looping part that I am struggling with.
This question raises a few points that this answer might resolve for you and others in the future:
I note that not many of your previous questions have accepted answers, and that several of them present answers but you have needed to respond by saying it doesn't suit your needs for a certain reason. It suggests you aren't really providing the right details in your question. I think that's the case here. Perhaps you could outline the outcome you are trying to achieve and, especially for Excel VBA, the precise structure of your spreadsheet data. It's tempting to think in this question that you simply want to know how to take the values of Columns C to F and write them to a comment in Column B for any row that contains data.
Using web code can often take more time to understand and adapt than learning the code syntax from first principles. Your provided code is difficult to follow and some parts seem odd. I wonder, for example, what this snippet is meant to do:
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Using Option Explicit at the top of your module (which forces you to declare your variables) makes VBA coding and debugging much easier, and code submitted on SO is easier to follow if we can see what data types you meant variables to hold.
If your question is merely "How do I take the values of Columns C to F and write them to the cell in Column B for any row that contains data?", then your code could be as simple as:
Dim condCol As Range
Dim cell As Range
Dim line1 As String
Dim line2 As String
Dim cmt As Comment
'Define the "Cond" column range
'Note: this is an unreliable method but we'll use it here for the sake of brevity
Set condCol = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns("B")
'Delete any comment boxes
condCol.ClearComments
'Loop through the cells in the column and process the data if it's a number
For Each cell In condCol.Rows
If Not IsEmpty(cell.Value) And IsNumeric(cell.Value) Then
'Acquire the comment data
line1 = "Cond: " & cell.Offset(, 1).Value & "/" & cell.Offset(, 2).Value & _
" (" & Format(cell.Offset(, 3), "0.00%") & ")"
line2 = "Cond pl: $" & cell.Offset(, 4).Value
Set cmt = cell.AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
End If
Next
If, on the other hand, your question is that you have unreliable data on your spreadsheet and your only certainty is that the headings exist on any one row, then some form of search routine must be added. In that case your code could look like this:
Dim rng As Range
Dim rowRng As Range
Dim cell As Range
Dim condCol(0 To 4) As Long
Dim line1 As String
Dim line2 As String
Dim allHdgsFound As Boolean
Dim i As Integer
Dim cmt As Comment
Set rng = ThisWorkbook.Worksheets("Sheet1").UsedRange
rng.ClearComments
For Each rowRng In rng.Rows
If Not allHdgsFound Then
'If we haven't found the headings,
'loop through the row cells to try and find them
For Each cell In rowRng.Cells
Select Case cell.Value
Case Is = "Cond": condCol(0) = cell.Column
Case Is = "Cond w": condCol(1) = cell.Column
Case Is = "Cond r": condCol(2) = cell.Column
Case Is = "Cond %": condCol(3) = cell.Column
Case Is = "Cond wpl": condCol(4) = cell.Column
End Select
Next
'Check if we have all the headings
'by verifying the condCol array has no 0s
allHdgsFound = True
For i = 0 To 4
If condCol(i) = 0 Then
allHdgsFound = False
Exit For
End If
Next
Else
If Not IsEmpty(rowRng.Cells(1).Value) Then
'The cell has values so populate the comment strings
line1 = "Cond: " & rowRng.Columns(condCol(1)).Value & "/" & _
rowRng.Columns(condCol(2)).Value & _
" (" & Format(rowRng.Columns(condCol(3)).Value, "0.00%") & ")"
line2 = "Cond pl: $" & rowRng.Columns(condCol(4))
Set cmt = rowRng.Columns(condCol(0)).AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
Else
'We've reached a blank cell so re-set the found values
allHdgsFound = False
Erase condCol
End If
End If
Next
Of course your data might be structured in any number of other ways, but we don't know that. My point is that if you can be more specific in your question and provide an outcome you are trying to achieve, you are likely to receive answers that are more useful to you.
The purpose of this macro is copy one cell value (from a long list) to another cell located in a different sheet.
here's my code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G2:G1048576")
For Each cell In Rng
'test if cell is empty
If cell.Value <> "" Then
finaljnl.Range("L4").Value = rawben.Range("G5").Value
finaljnl.Range("K4").Value = rawben.Range("L5").Value
End If
Next
End Sub
With the help of the image, I will explain what I'm trying to achieve:
From Sheet1 ("BEN") there's a list sitting in columns G and L.
I will copy the cell G5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range K4.
Next is I will copy the cell L5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range L4.
Copy the next in line and do the same process just like No.2 and 3 but this time, it will adjust 1 row below.
Copy the whole list. That means up to the bottom. The list is dynamic, sometimes it will go for 5,000 rows.
For some reasons, copying the entire column is not an option to this macro due to requirement that cells from sheet1 MUST be pasted or placed in Sheet2 from left to right (or horizontally).
I hope you could spare some time to help me. My code didn't work, I guess the implementation of FOR EACH is not correct. I'm not sure if FOR EACH is the best code to use.
I appreciate anyone's help on this. Thank you very much! May the force be with you.
Try this:
Sub journalben()
Dim i As Long, lastRow As Long
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
lastRow = rawben.Cells(Rows.Count, "G").End(xlUp).Row
For i = 5 To lastRow
'test if cell is empty
If rawben.Range("G" & i).Value <> "" Then
finaljnl.Range("K" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("L" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
I am starting FOR from 5 as the data in your image starts from cell G5 (not considering the header).
It'll be easier to use a numeric variable for this :
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = rawben.Range("G4:G1048576")
For i = Rng.Cells(1,1).Row to Rng.Cells(1,1).End(xlDown).Row
'test if cell is empty
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("K" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
You should use a simple for loop. It is easier to work with.
Also, to have it dynamic and to go to the last cell in the range, use the SpecialCells method.
And your range needs to be set correctly from row 5.
Here is the code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G5:G1048576")
For i = Rng.Cells(1,1).Row to Rng.SpecialCells(xlCellTypeLastCell).Row
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & CStr(i - 1)).Value = rawben.Range("G" & CStr(i)).Value
finaljnl.Range("K" & CStr(i - 1)).Value = rawben.Range("L" & CStr(i)).Value
End If
Next i
End Sub
I'm developing a worksheet users can fill out to generate a file that can be uploaded into SAP.
The worksheet will generate a mass upload of individual entries. Users will be asked to provide attributes for each line item they are requesting, which may vary based on the selection made (i.e. one row may have 5 attributes while the next may have 7).
I want to write a macro that will look at each row, starting from the top, and concatenate only the attribute columns (which are separated by two other columns in each instance) which are not blank and use a delimiter between each field.
I've been able to use some code I found through Microsoft to get the looping done (see below), but I can't figure out how to have the concatenate stop when a column is blank and then move to the next row.
Sub Submit()
Range("C2").Activate
Do While ActiveCell <> ""
ActiveCell.Offset(0, 21).FormulaR1C1 = _
ActiveCell.Offset(0, 0) & "-" & ActiveCell.Offset(0, 3) & "-" &
ActiveCell.Offset(0, 6) & "-" & ActiveCell.Offset(0, 9) & "-" & ActiveCell.Offset(0, 12) & "-" & ActiveCell.Offset(0, 15) & "-" & ActiveCell.Offset(0, 18)
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Right now, this code will take a five attribute entry and leave me with "1-2-3-4-5--", when I really want it to show up as "1-2-3-4-5".
Any thoughts on how I can go about doing this? Eventually, I want to be able to store those strings and populate them in a new workbook with some other information copied over from the original workbook.
Untested:
Sub Submit()
Dim c As Range, c2 As Range, v as String
Set c = Range("C2")
Do While c.Value <> ""
Set c2 = c
v = ""
Do While c2.value <> ""
v = v & IIf(v <> "", "-", "") & c2.value
Set c2 = c2.offset(0, 3)
Loop
c.offset(0, 21).Value = v
Set c = c.Offset(1, 0)
Loop
End Sub
This is a quick answer, so may not have everything you're after:
Public Function Submit(Target As Range) As String
Dim sFinalOutput As String
Dim rCell As Range
'Cylce through each cell in your range.
For Each rCell In Target
'Look at the column number divided by 3 - if it's 0 then carry on.
If rCell.Column Mod 3 = 0 Then
If rCell.Value2 <> "" Then
'Grab the value from the cell and add it to the final output.
sFinalOutput = sFinalOutput & "-" & rCell.Value2
End If
End If
Next rCell
Submit = sFinalOutput
End Function
Use it in a formula such as: =submit(C4:L4)
I've written a procedure that should determine some values, enter them in specific cells and launch a procedure that depends on these same cells.
It worked once, but then the proc started to act like the cells were empty.
The form contains three textboxes (ratebox, amountbox, cfbox), as well as one combobox:
Private Sub CommandButton1_Click()
If ratebox.value = "" Or amountbox.value = "" Or numbercfbox.value = "" Or cfbox.value = "" _
Or Not IsNumeric(ratebox.value) Or Not IsNumeric(amountbox.value) Or Not IsNumeric(cfbox.value) Or Not IsNumeric(numbercfbox.value) Then
MsgBox "valeur"
Exit Sub
End If
Cells(3, 1) = ratebox.value / 100
Cells(3, 2) = amountbox.value
For i = 1 To numbercfbox.value
Cells(3, i + 2) = cfbox.value
Next
callproc_e1
Unload form_e1
End Sub
The procedure starts with:
Sub e1s1()
rate = Cells(3, 1)
amount = Cells(3, 2)
numbercf = Cells(3, 3).End(xlToRight).column - 2
'MsgBox (rate & Chr(10) & amount & Chr(10) & numbercf)
ReDim cf(numbercf) As Double
I've tried registering the box values in variables and entering the variables in the cell before launching the procedure, doesn't work.
I've put a msgbox with all the values just before launching the procedure:
Cells(3, i + 2) = cfbox.value
Next
MsgBox (ratebox.value & Chr(10) & amountbox.value & Chr(10) & numbercfbox.value & Chr(10) & cfbox.value)
callproc_e1
When the msgbox appears, I can see that the values are written down in the cells, but the procedure still acts like these cells are empty: numbercf is 16382.
Your code will fill cells in the active worksheet of the active workbook. If it fails sometimes, you should specify the sheet with lines like:
Sheets("Sheet1").Cells(3, 1) = ratebox.value / 100
I've finally located the problem: in my call sub, the first action was to delete all cells.
Thanks to all those who tried to help.