Getting Right Cell Name of current Cell VBA excel - vba

I have current cell name like B7 i want to get cell name of the cell right to current cell for example in this case the result will be C7. How can I achieve this
This is what I have tired but its not working
CellName = "B7"
ValueCellName = Right(Range(CellName)).name

Try using offset function:
valuecellname = Range(cellname).Offset(0, 1).Address

Is this what you are trying?
Sub Sample()
Debug.Print GetrightCell("B7")
Debug.Print GetrightCell("XFD7")
Debug.Print GetrightCell("ADIL1234")
End Sub
'~~> Function returns the right cell if there is one!
Function GetrightCell(CellName As String) As String
On Error GoTo Whoa
If Range(CellName).Column <> Columns.Count Then
GetrightCell = Range(CellName).Offset(0, 1).Address
Else
GetrightCell = "There are no more cells to the right of this cell"
End If
Exit Function
Whoa:
GetrightCell = "Invalid Cell Name"
End Function

Related

Cell value from offset range

yellow_cell = ActiveCell.Address
MsgBox (Range(yellow_cell).Value)
implant = yellow_cell.Offset(6, -2).Address
MsgBox (Range(implant).Value)
The first MsgBox works, but the second one doesn't (Run-time error 424, object required).
I've also tried this:
implant = ActiveCell.Offset(6, -2).Address
MsgBox (Range(implant).Value)
And I get a run-time error 1004, Method 'Offset' of object 'Range' failed.
Anyone know what I'm doing wrong? I've unmerged all cells btw.
Here's the proper way to achieve the desired results:
Dim implant As Range, yellow_cell As Range
Set yellow_cell = ActiveCell
MsgBox yellow_cell.Value
Set implant = yellow_cell.Offset(6, -2)
MsgBox implant.Value
Notice: If the active cell is less than two columns away from column A, then this code will result in run-time error 1004, due to the second parameter of the Offset function.
Another way to achieve this is to test whether the column is in fact further right than 2 columns, something like below, this shouldn't cause any errors:
Sub foo()
Dim yellow_cell As String, implant As String
Dim col As Long
yellow_cell = ActiveCell.Address
MsgBox (Range(yellow_cell).Value)
col = ActiveCell.Column
If col > 2 Then
implant = ActiveCell.Offset(6, -2).Address
MsgBox (Range(implant).Value)
Else
MsgBox "Out of Range!", vbInformation, "Error"
End If
End Sub

Use VLookup to see if selected cell is in a range?

I've seen how to say "Is cell x in range y" but since I'm using VLookup I'm not sure how to reconcile the two.
Basically, the code below does a lookup on a table that contains tips and then displays them in a specified cell. It works great. What I would like to do is specify an entire range of cells in the lookup table, then if the user selects any cell within that range the tip is displayed. As it stands, if I have a large area of say 10 cells I have to create 10 duplicate entries in the lookup table (one for each cell).
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cellTitle As Range
Set cellTitle = Range("J2")
Dim cellTip As Range
Set cellTip = Range("J3")
If Target.Address = "$J$3:$K$5" Or Target.Address = "$J$2:$K$2" Or Target.Address = "$K$1" Then
'leave existing content in case user wants to copy tip
Else
Range("K1").Value = Target.Address
Title = Application.VLookup(Target.Address, Sheets("Settings").Range("TipsDashboard"), 2, False)
If Not IsError(Title) Then
Tip = Application.VLookup(Target.Address, Sheets("Settings").Range("TipsDashboard"), 3, False)
cellTitle.Value = Title
cellTip.Value = Tip
Else
cellTitle.Value = "Tips & Instructions"
cellTip.Value = "Try selecting various fields to get dynamic tips or instructions in this space."
End If
End If
End Sub
Here is a sample of my lookup table:
You'll notice there are ranges here, but they are merged cells.
edited: made so that it's possible to associate different cells in active sheet to the same range value in "cell" column of" Settings" sheet
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim cellTitle As Range, cellTip As Range, found As Range
Set cellTitle = Range("J2")
Set cellTip = Range("J3")
If target.address = "$J$3:$K$5" Or target.address = "$J$2:$K$2" Or target.address = "$K$1" Then
'leave existing content in case user wants to copy tip
Else
Range("K1").Value = target.address
Set found = GetCell(target, Sheets("Settings").Range("TipsDashboard").Columns(1))
If Not found Is Nothing Then
cellTitle.Value = found.Offset(, 1)
cellTip.Value = found.Offset(, 2)
Else
cellTitle.Value = "Tips & Instructions"
cellTip.Value = "Try selecting various fields to get dynamic tips or instructions in this space."
End If
End If
End Sub
Function GetCell(target As Range, sourceRng As Range) As Range
Dim cell As Range, cell2 As Range
With target
For Each cell In sourceRng.SpecialCells(xlCellTypeConstants, xlTextValues)
Set cell2 = GetRangeFromAddress(.Parent, cell.Value)
If Not cell2 Is Nothing Then
If Not Intersect(.cells, cell2) Is Nothing Then
Set GetCell = cell
Exit Function
End If
End If
Next cell
End With
End Function
Function GetRangeFromAddress(sht As Worksheet, address As String) As Range
On Error Resume Next
Set GetRangeFromAddress = sht.Range(address)
On Error GoTo 0
End Function

How to check that Excel cell contains REF! error in VBA

I found many discussions on how to do it in Excel, but my goal is to capture REF! error in VBA, not in Excel itself. Is it possible ?
If IsError(cell.Value) Then
If cell.Value = CVErr(xlErrName) Then
...
End If
End If
The original code is wrong and will give a Type Mismatch error if the cell does not contain an error.
If cell.Value = CVErr(xlErrRef) Then
...
End If
Sub CheckRef()
Dim CheckRange As Range, CheckCell As Range
Set CheckRange = [A1:D10] ' as per app
For Each CheckCell In CheckRange
If IsError(CheckCell) And _
CVErr(CheckCell) = CVErr(2023) Then ' 2023 --> xlErrRef
MsgBox ("#REF! in " & CheckCell.AddressLocal)
Exit Sub ' exit after first #REF! found
End If
Next CheckCell
End Sub
example
enter "=1/0" in B2 to create an error different to "#REF!"
enter 1 in B4, B5
enter "=B4+B5" in B7
delete row 4
run Sub CheckRef()

vba access function for extract cell value

I'm trying to write a function for extract cell string value of the first previous valorized cell of a certain column.
I try to explain better:
I've a column in witch not all cells cointans values.
So if I want to build a function that accept as parameter 1 cell, e.g. 'A5'.
If into A5 cell there is not any value it check if previous cell (A4) has some value. If fails again it recursively go back (A3..A2..A1) until it find something.
Public Function getPreviousValorizedCellValue(ByVal cell As Range) As String
If (cell.Value = "") Then
Set cell = cell.Offset(-1, 0)
getPreviousValorizedCellValue (cell)
Else: getPreviousValorizedCellValue = cell.Value
End If
End Function
It doesnt work. Excel give me error
Any ideas?
try this:
Public Sub TestgetPrevious()
Dim cell As Range
Set cell = ActiveSheet.Range("A5")
MsgBox getPreviousValorizedCellValue_v2(cell)
End Sub
Public Function getPreviousValorizedCellValue_v2(ByVal cell As Range) As String
Debug.Print cell.Address
If cell.Row <= 0 Then Exit Function
If (Trim(cell.Value = "")) Then
If cell.Row > 1 Then
Set cell = cell.Offset(-1, 0)
getPreviousValorizedCellValue_v2 = getPreviousValorizedCellValue_v2(cell)
Else
getPreviousValorizedCellValue_v2 = ""
End If
Else
getPreviousValorizedCellValue_v2 = cell.Value
End If
End Function
Try the below Code.
Function Foo(iRange As Range)
For i = iRange.Row To 1 Step -1
If Trim(Range("A" & i).Value) <> "" Then
Foo = Range("A" & i).Value 'Put the code you want here
Exit Function
End If
Next i
End Function

How to fill color in a cell in VBA?

I would like to color cells that have "#N/A" value in the currentsheet. In order to do this i use following macro:
Sub ColorCells()
Dim Data As Range
Dim cell As Range
Set currentsheet = ActiveWorkbook.Sheets("Comparison")
Set Data = currentsheet.Range("A2:AW1048576")
For Each cell In Data
If cell.Value = "#N/A" Then
cell.Interior.ColorIndex = 3
End If
Next
End Sub
But the line If cell.Value = "#N/A" Then gives an error: Type mismatch. Maybe someone can help to understand where is the error? Thanks
Non VBA Solution:
Use Conditional Formatting rule with formula: =ISNA(A1) (to highlight cells with all errors - not only #N/A, use =ISERROR(A1))
VBA Solution:
Your code loops through 50 mln cells. To reduce number of cells, I use .SpecialCells(xlCellTypeFormulas, 16) and .SpecialCells(xlCellTypeConstants, 16)to return only cells with errors (note, I'm using If cell.Text = "#N/A" Then)
Sub ColorCells()
Dim Data As Range, Data2 As Range, cell As Range
Dim currentsheet As Worksheet
Set currentsheet = ActiveWorkbook.Sheets("Comparison")
With currentsheet.Range("A2:AW" & Rows.Count)
.Interior.Color = xlNone
On Error Resume Next
'select only cells with errors
Set Data = .SpecialCells(xlCellTypeFormulas, 16)
Set Data2 = .SpecialCells(xlCellTypeConstants, 16)
On Error GoTo 0
End With
If Not Data2 Is Nothing Then
If Not Data Is Nothing Then
Set Data = Union(Data, Data2)
Else
Set Data = Data2
End If
End If
If Not Data Is Nothing Then
For Each cell In Data
If cell.Text = "#N/A" Then
cell.Interior.ColorIndex = 4
End If
Next
End If
End Sub
Note, to highlight cells witn any error (not only "#N/A"), replace following code
If Not Data Is Nothing Then
For Each cell In Data
If cell.Text = "#N/A" Then
cell.Interior.ColorIndex = 3
End If
Next
End If
with
If Not Data Is Nothing Then Data.Interior.ColorIndex = 3
UPD: (how to add CF rule through VBA)
Sub test()
With ActiveWorkbook.Sheets("Comparison").Range("A2:AW" & Rows.Count).FormatConditions
.Delete
.Add Type:=xlExpression, Formula1:="=ISNA(A1)"
.Item(1).Interior.ColorIndex = 3
End With
End Sub
Use conditional formatting instead of VBA to highlight errors.
Using a VBA loop like the one you posted will take a long time to process
the statement If cell.Value = "#N/A" Then will never work. If you insist on using VBA to highlight errors, try this instead.
Sub ColorCells()
Dim Data As Range
Dim cell As Range
Set currentsheet = ActiveWorkbook.Sheets("Comparison")
Set Data = currentsheet.Range("A2:AW1048576")
For Each cell In Data
If IsError(cell.Value) Then
cell.Interior.ColorIndex = 3
End If
Next
End Sub
Be prepared for a long wait, since the procedure loops through 51 million cells
There are more efficient ways to achieve what you want to do. Update your question if you have a change of mind.
Select all cells by left-top corner
Choose [Home] >> [Conditional Formatting] >> [New Rule]
Choose [Format only cells that contain]
In [Format only cells with:], choose "Errors"
Choose proper formats in [Format..] button
You need to use cell.Text = "#N/A" instead of cell.Value = "#N/A". The error in the cell is actually just text stored in the cell.