I created the following macro in VBA but when I call it nothing happens. Any ideas why this might not work?
Sub RemoveWords(DeleteFromCol As Range, FindCol As Range)
Dim words As New Collection
Dim r As Range
Dim word As Variant
For Each r In FindCol
words.Add (r.Value2)
Next r
For Each r In DeleteFromCol
For Each word In words
r.Value2 = Replace(r.Value2, word, "")
Next word
Next r
End Sub
Sub Remove()
RemoveWords Range("A1:A233"), Range("B1:B5")
End Sub
Macro does not work because perhaps you are not passing mandatory arguments:
(DeleteFromCol As Range, FindCol As Range)
Is that correct?
Got it work now. It was due to having cells with multiple words in them. You have to split cells up to contain 1 word each and it runs fine.
Related
I have to create a large number (1000-5000) of hyperlinks in word with VBA. This procedure is necessary every time the document is started. I'd like to speed up my code.
Sub CreateHyperlinks(raHypers() As Range, saSubaddresses() As String, saScreentips() As String)
Dim i As Integer
Application.Visible = False
Application.ScreenUpdating = False
With ActiveDocument.Hyperlinks
For i = 0 To UBound(raHypers)
.Add raHypers(i), , saSubaddresses(i), saScreentips(i)
Next i
End With
End Sub
The array raHypers() is already sorted by the start property of the range variable in ascending order. I have already tried different things, but the code still takes quite long. Has anybody an idea how to speed it up?
did you tried a "for each" loop instead of your loop?
Sub CreateHyperlinks()
Dim myHyperlink As Hyperlink
For Each myHyperlink In ActiveDocument.Hyperlinks
*your code*
Next myHyperlink
End Sub
Edit1:
I missunderstood your question at 1st read, but you can use it nevertheless.
You just have to access the range of your hyperlinks with a "for each" loop instead of looping through it with an index.
This could speedup your code.
Sub CreateHyperlinks( _
raHypers() As Range, _
saSubaddresses() As String, _
saScreentips() As String)
Dim myRange As Range
For Each myRange In raHypers
' your code
Next myRange
End Sub
Edit:
Sry, i have no further ideas to speedup your code.
I found a UDF that calculates the values of a cell based on their color. It worked perfectly the first time that I used it. However, now when I change the color of a cell (the color dictates if the cell has been planned or executed), in the existing workbook it does not auto-update. See code below:
Function SumByColor(CellColor As Range, rRange As Range)
Application.Volatile True
Dim cSum As Long
Dim ColIndex As Integer
Dim cl As Variant
ColIndex = CellColor.Interior.ColorIndex
For Each cl In rRange
If cl.Interior.ColorIndex = ColIndex Then
cSum = WorksheetFunction.Sum(cl, cSum)
End If
Next cl
SumByColor = cSum
End Function
I have tried Application.Volitale, but no luck. F9 works to update the cells that house the function. Though, it would be better to auto-update in case I get busy, or walk away from my WS. Any ideas?
You can create a worksheet event proc that will run when a change is recognized on the sheet:
Private Sub Worksheet_Change(ByVal Target as Range)
'Call function with appropriate variables
End Sub
I'm just wondering how I would go about converting a range of cells from decimal to hex without making the spreadsheet huge and very slow. I would also like to use VBA for it as it would be used for analysis.
The way I have thought about doing this would be to convert the cells using the DEC2HEX formula and then hiding all the decimal cells but obviously this makes the spreadsheet quite large. If there is a way to just convert the values and replace those cells with the hex value, it would be very helpful.
Any advice would be much appreciated. Thanks in advance.
One possible solution ->
Sub convertRangeToHex()
Dim r As Range
Dim myRange As Range: Set myRange = Application.Selection 'define your range
For Each r In myRange
If IsNumeric(r.Value) Then
r.Value = "0x" & WorksheetFunction.Dec2Hex(r.Value)
End If
Next
End Sub
You can use Dec2Hex in VBA through the WorksheetFunction class:
Option Explicit
Sub Test()
ConvertToHex Sheet1.Range("A1:A15")
End Sub
Sub ConvertToHex(rngData)
Dim rngCell As Range
For Each rngCell In rngData
rngCell.Value = WorksheetFunction.Dec2Hex(rngCell.Value)
rngCell.NumberFormat = "#" '<-- tidies formatting of hex
Next
End Sub
I have created a VBA macro simple to absurdity.
For each row in range, then for each cell in row and then for each character in cell.
But it returns property or method not supported.
Now, to refer to each character in a cell in Excel VBA, it has to be defined as a range. So how is not a cell in a row in a range not a range object?
In all Excel examples the cells with Characters property have been referred to in absolute values. Like Worksheets("Sheet1").Range("A1")
Do I have to write a code of
Worksheets("MySheet").Range("B1")
...
Worksheets("MySheet").Range("B2")
...
...
Worksheets("MySheet").Range("B250")
To access characters or is there a way to access each character in a cell without Mid function?
By the way, Mid function looses formatting but I am looking for underlined characters.
My program is like this
Sub Celltest()
For Each rw In Sheets("Joblist").Range("B1:D250").Rows
For Each cel In rw.Cells
For Each char In cel.Characters
If char.Font.Underline = True Then MsgBox char
Next
Next
Next
End Sub
As a result I get message that a property or method is not supported.
Thank you!
David
"Why is suddenly a part of a range object suddenly not a range?" That's not the issue. The error is Object doesn't support this property or method. That means that (basically) anything after the . is an object, so the error is telling you that something is up with how you're using .Character.
I did some quick searching around, and this works:
Sub Celltest2()
Dim rw As Range, cel As Range
Dim i As Integer
Dim char
For Each rw In Sheets("Joblist").Range("B1:D250").Rows
For Each cel In rw.Cells
For i = 1 To Len(cel)
'Debug.Print cel.Characters(i, 1).Text
If cel.Characters(i, 1).Font.Underline = 2 Then
MsgBox (cel.Characters(i, 1).Text)
End If
Next i
Next
Next
End Sub
I just looked up the Characters Object documentation, and there is the answer of how to use .Characters. The issue is how .Characters is used with the range - no sophisticated skills or knowledge necessary. Just use the VB Error messages.
Two things I noticed. 1. Characters is not a collection, so For Each won't work. 2. Font.Underline is not Boolean. Try something like:
Sub Celltest()
Dim rw As Excel.Range
Dim cel As Excel.Range
Dim char As Excel.Characters
Dim I As Long
For Each rw In Sheets("Joblist").Range("B1:D250").Rows
For Each cel In rw.Cells
For I = 1 To cel.Characters.Count
Set char = cel.Characters(I, 1)
If char.Font.Underline <> xlUnderlineStyleNone Then MsgBox char.Text
Next I
Next
Next
Set rw = Nothing
Set cel = Nothing
Set char = Nothing
End Sub
Hope that helps
I have a value in a cell. This value is duplicated, intentionally, in another part of the worksheet. I would like to be able to click the cell in C5 with contents 12345 and it selects the cell in A1:1600 that contains the same value. I will never have more than 2 cells with this same value in the worksheet, but the values will change.
I appreciate any help you can offer.
Thank You.
This should do the trick - I was unsure of the range you wanted to specify, so I just put it as A1:Z1600, but change it as necessary.
In VBA, paste this into your sheet's code module:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim OriginalAddress As String
Dim ValToFind As String
Dim CurrentCell As Range
OriginalAddress = Target.Parent.Address
ValToFind = Target.Parent.Value
With Range("A1:Z1600")
Set CurrentCell = .Find(What:=ValToFind)
If OriginalAddress = CurrentCell.Address Then
.FindNext(After:=CurrentCell).Activate
Else
CurrentCell.Activate
End If
End With
End Sub
You can use the Hyperlink function to do what you wanting. But you would have to manually type out the formula for each cell that you wanted to link... Here's an example:
=HYPERLINK("[Book1]Sheet1!F2",12345)
This method is very unwieldy. The only way to do what you want in a robust fashion would be to use VBA.
Edit: I was able to duplicate the issue. The below edits seem to resolve the issue.
This VBA solution used the FindNext function to find the next value in the sheet:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim FirstAddress As String
Dim Rng As Range
Dim x As Long
x = Me.UsedRange.Rows.Count
FirstAddress = Target.Address
Set Rng = Me.UsedRange.Find(Target.Value)
If FirstAddress = Rng.Address Then
Me.UsedRange.FindNext(Rng).Select
Else
Rng.Select
End If
End Sub
This works with a double click for the sheet the code is in, and it doesn't matter where the duplicate value is in that sheet. Just place the code in your worksheet's module.
One last way to do this (although still inferior to VBA) is to insert the hyperlink:
In this example, you click on A2>go to Insert Tab>Hyperlink>Place in This Document and enter the corresponding cell. This hyperlinks cell A2 to F2 so that when A2 is selected F2 is selected.