I have this VBA code running on my excel sheets that takes each cell and hyperlinks it to another cell in the workbook if a text match is found. It works great, but it overwrites the cell color settings to make each cell blue and underlined. For some of the cell colors, this makes the text hard to read.
I'm looking to modify my current code to check the cell format code of the current cell in the loop and change the text color if it matches one of a certain set of values.
In my case, if the value of CELL("format", B2) returns P3, F1, F2, F3, F4, F5, or F6, I'd like the cell text color to be changed to white before the loop runs the next cell.
Here is the code working so far. Any help is greatly appreciated!
Sub mySheet()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim dws As Worksheet: Set dws = wb.Sheets("mySheet")
Dim drg As Range: Set drg = dws.Range("B2:B20")
drg.ClearHyperlinks
drg.Font.Underline = False
Dim sws As Worksheet, scell As Range, dcell As Range
Dim dValue As Variant, IsValueValid As Boolean
For Each dcell In drg.Cells
dValue = dcell.Value
IsValueValid = False
If Not IsError(dValue) Then
If Len(dValue) > 0 Then IsValueValid = True
End If
If IsValueValid Then
For Each sws In wb.Worksheets
If sws.Name <> dws.Name Then
Set scell = sws.UsedRange.Find(What:=dValue, _
LookIn:=xlValues, LookAt:=xlWhole)
If Not scell Is Nothing Then
dws.Hyperlinks.Add _
Anchor:=dcell, _
Address:="", _
SubAddress:="'" & sws.Name & "'!" & scell.Address, _
TextToDisplay:=CStr(dValue)
Exit For
End If
End If
Next sws
End If
' %%insert custom format code here?? %%% '
Next dcell
MsgBox "Hyperlinks generated.", vbInformation
End Sub
'''
I can't seem to find an equivalent for the CELL("format", B2) in VBA which is where I'm getting stuck even beginning the code. As an alternative, I could also check the color of the cell and if it's a certain value then I could change the text color. I tried inserting that code into the existing code but it didn't work for me - maybe I put it in the wrong place?
Sub mySheet()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim dws As Worksheet: Set dws = wb.Sheets("mySheet")
Dim drg As Range: Set drg = dws.Range("B2:B20")
drg.ClearHyperlinks
drg.Font.Underline = False
Dim sws As Worksheet, scell As Range, dcell As Range
Dim dValue As Variant, IsValueValid As Boolean
For Each dcell In drg.Cells
dValue = dcell.Value
IsValueValid = False
If Not IsError(dValue) Then
If Len(dValue) > 0 Then IsValueValid = True
End If
If IsValueValid Then
For Each sws In wb.Worksheets
If sws.Name <> dws.Name Then
Set scell = sws.UsedRange.Find(What:=dValue, _
LookIn:=xlValues, LookAt:=xlWhole)
If Not scell Is Nothing Then
dws.Hyperlinks.Add _
Anchor:=dcell, _
Address:="", _
SubAddress:="'" & sws.Name & "'!" & scell.Address, _
TextToDisplay:=CStr(dValue)
Exit For
End If
End If
Next sws
End If
If dcell.Interior.Color = RGB(155, 0, 255) _
Then Set dcell.Font.Color = RGB(255, 255, 255)
Next dcell
MsgBox "Hyperlinks generated.", vbInformation
End Sub
'''
I have this VBA code running on my excel sheets that takes each cell and hyperlinks it to another cell in the workbook if a text match is found. It works great, but it overwrites the cell color settings to make each cell blue and underlined. For some of the cell colors, this makes the text hard to read.
I'm looking to modify my current code to check the cell format code of the current cell in the loop and change the text color if it matches one of a certain set of values.
In my case, if the value of CELL("format", B2) returns P3, F1, F2, F3, F4, F5, or F6, I'd like the cell text color to be changed to white before the loop runs the next cell.
Here is the code working so far. Any help is greatly appreciated!
Sub mySheet()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim dws As Worksheet: Set dws = wb.Sheets("mySheet")
Dim drg As Range: Set drg = dws.Range("B2:B20")
drg.ClearHyperlinks
drg.Font.Underline = False
Dim sws As Worksheet, scell As Range, dcell As Range
Dim dValue As Variant, IsValueValid As Boolean
For Each dcell In drg.Cells
dValue = dcell.Value
IsValueValid = False
If Not IsError(dValue) Then
If Len(dValue) > 0 Then IsValueValid = True
End If
If IsValueValid Then
For Each sws In wb.Worksheets
If sws.Name <> dws.Name Then
Set scell = sws.UsedRange.Find(What:=dValue, _
LookIn:=xlValues, LookAt:=xlWhole)
If Not scell Is Nothing Then
dws.Hyperlinks.Add _
Anchor:=dcell, _
Address:="", _
SubAddress:="'" & sws.Name & "'!" & scell.Address, _
TextToDisplay:=CStr(dValue)
Exit For
End If
End If
Next sws
End If
' %%insert custom format code here?? %%% '
Next dcell
MsgBox "Hyperlinks generated.", vbInformation
End Sub
'''
I can't seem to find an equivalent for the CELL("format", B2) in VBA which is where I'm getting stuck even beginning the code. As an alternative, I could also check the color of the cell and if it's a certain value then I could change the text color. I tried inserting that code into the existing code but it didn't work for me - maybe I put it in the wrong place?
Sub mySheet()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim dws As Worksheet: Set dws = wb.Sheets("mySheet")
Dim drg As Range: Set drg = dws.Range("B2:B20")
drg.ClearHyperlinks
drg.Font.Underline = False
Dim sws As Worksheet, scell As Range, dcell As Range
Dim dValue As Variant, IsValueValid As Boolean
For Each dcell In drg.Cells
dValue = dcell.Value
IsValueValid = False
If Not IsError(dValue) Then
If Len(dValue) > 0 Then IsValueValid = True
End If
If IsValueValid Then
For Each sws In wb.Worksheets
If sws.Name <> dws.Name Then
Set scell = sws.UsedRange.Find(What:=dValue, _
LookIn:=xlValues, LookAt:=xlWhole)
If Not scell Is Nothing Then
dws.Hyperlinks.Add _
Anchor:=dcell, _
Address:="", _
SubAddress:="'" & sws.Name & "'!" & scell.Address, _
TextToDisplay:=CStr(dValue)
Exit For
End If
End If
Next sws
End If
If dcell.Interior.Color = RGB(155, 0, 255) _
Then Set dcell.Font.Color = RGB(255, 255, 255)
Next dcell
MsgBox "Hyperlinks generated.", vbInformation
End Sub
'''
Share
Improve this question
asked Feb 5 at 18:04
RhedogianRhedogian
11 bronze badge
2
|
1 Answer
Reset to default 0Figured it out - I added this snippet at the bottom before "hyperlinks generated". Thanks @Tim Williams
For Each dcell In drg.Cells
dFormat = dcell.Worksheet.Evaluate("=CELL(""format""," & dcell.Address & ")")
IsFormatValid = False
If dFormat = "F6" Then
dcell.Font.Color = RGB(255, 255, 255)
End If
Next dcell
scell.Worksheet.Evaluate("=CELL(""format""," & scell.address & ")")
should do the same as the worksheet formula – Tim Williams Commented Feb 5 at 18:19