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
Related
I am trying to use a formula with INDEX and MATCH to return a cell reference to enter TEXT into with VBA.
I have a list of vendors in column A and to find the cell to the right of it I can use the following
=CELL("address";INDEX(A29:C42;MATCH("***";A29:A42;0);2))
However I am struggling with how to get this in my VBA code. (note the value *** is changing as I need to run the sub several times for different vendors.
Can i use Function sub for this? I have tried as below with no luck:
Sub CellRef()
'
' CellRef
'
'
Function.Range(="CELL("ADDRESS";INDEX(A29:C42;MATCH("Accenture";A29:A42;0);2))")
End Sub
If I understand your question correctly you want to match the value/vendor in column A and return the address of the cell to its right?
You can do like so:
Cell2WorkWith = Cells(Application.Match(Searchvalue, Searchrange, 0),2).Address
If you don't want the "$", then replace them like so:
Cell2WorkWith = Replace(Cells(Application.Match(Searchvalue, Searchrange, 0),2).Address,"$","")
Or, even better, like:
Cell2WorkWith = Cells(Application.Match(Searchvalue, Searchrange, 0),2).Address(0,0)
If I misunderstood and it is the value from that cell to the right then below will do:
Value2WorkWith = Cells(Application.Match(Searchvalue, Searchrange, 0),2).Value
Remember to only use match when the value CAN be found within the range, else you'll have to catch an error.
One alternative would be to look for the cell with "Find":
Option Explicit
Sub CellRef()
Dim SearchString As String
Dim ra, cell, VendorsRange As Range
Dim k As Integer
Set VendorsRange = Range("E1:E10")
k = 1
For Each cell In VendorsRange
SearchString = cell.Value
Set ra = Range("A29:A42").Find(What:=SearchString, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
MsgBox "String not available"
Else
Range("D" & k).Value = ra.Offset(0, 1).Address 'Change "D1" to whereever you want to put your result in
End If
k = k + 1
Next cell
End Sub
The code would check for every vendor (in my code range "E1:E10"), where is the cell in your range A29:A42 and returns the address of the cell next to it.
Some people prefer to find all occurrences of a searched item, and then change the value or the formula, or do else. Here is some code allowing great flexibility using an array.
'**************************************************************************************************************************************************************
'To return an array of information (value, formula, address, row, and column) for all the cells from a specified Range that have the searched item as value
'Returns an empty array if there is an error or no data
'**************************************************************************************************************************************************************
Public Function makeArrayFoundCellInfoInRange(ByVal itemSearched As Variant, ByVal aRange As Variant) As Variant
Dim cell As Range, tmpArr As Variant, x As Long
tmpArr = Array()
If TypeName(aRange) = "Range" Then
x = 0
For Each cell In aRange
If itemSearched = cell.Value Then
If x = 0 Then
ReDim tmpArr(0 To 0, 0 To 4)
Else
tmpArr = reDimPreserve(tmpArr, UBound(tmpArr, 1) + 1, UBound(tmpArr, 2))
End If
tmpArr(x, 0) = cell.Value
tmpArr(x, 1) = cell.Formula
tmpArr(x, 2) = cell.Address(0, 0) 'Without the dollar signs
tmpArr(x, 3) = cell.Row
tmpArr(x, 4) = cell.Column
x = x + 1
End If
Next cell
End If
makeArrayFoundCellInfoInRange = tmpArr
Erase tmpArr
End Function
I'm trying to create a VBA function that starts from the bottom of a range, and returns the first value that's different from the value at the bottom.
Example:
In the above table, I'd like to be able to grab the last value in the "Month" column (11), and iterate to the top until the value 10 is reached, and return that value.
I just started looking into VBA 3 days ago and am very unfamiliar with the language so I'm still trying to grok the syntax.
I have no doubt that my thinking is fuzzy with this, so I'd really appreciate feedback on my errors.
Here's what I have right now:
Code:
Function NextValue(num1 As Range)
For c = num1.End(xlDown) To num1.Item(1)
If Cells(c, 1) <> num1.End(xlDown) Then
NextValue = Cells(c, 1)
Exit For
End If
Next c
End Function
In case it's not clear, here's a description of what I'm trying to do, line-by-line.
1). Initiate a For-Loop that begins at the end of a range and decrements to the top
2). Check if that cell does not match the last value in that column
3). If it does not, then set the value of the function to that value
4). Terminate If statements, For loops, and end the function.
Your help is greatly appreciated.
Try this:
Function NextValue(num1 As Range) as Integer
Dim y As Integer
'get the last cell from num1
Set num1 = num1.End(xlDown)
y = -1
Do Until num1.Offset(y, 0).Value <> num1.Value
y = y - 1
Loop
'set function return to the different cell
NextValue = num1.Offset(y, 0).value
End Function
This will handle both compact ranges and disjoint ranges:
Option Explicit
Public Function SomethingElse(rng As Range) As Variant
Dim r As Range, values() As Variant
Dim i As Long, strvalue As Variant
ReDim values(1 To rng.Count)
i = 1
For Each r In rng
values(i) = r.Value
i = i + 1
Next r
strvalue = values(rng.Count)
For i = rng.Count To 1 Step -1
If values(i) <> strvalue Then
SomethingElse = values(i)
Exit Function
End If
Next i
SomethingElse = CVErr(xlErrNA)
End Function
Not clear to me if you want an UDF or a code to be used in a macro
in the first case you've already been given answers
in the latter case you may want to consider these two options:
Public Function FirstDifferent(rng As Range) As Variant
With rng.Parent.UsedRange
With Intersect(.Resize(, 1).Offset(, .Columns.Count), rng.EntireRow)
.Value = rng.Value
.RemoveDuplicates Array(1)
FirstDifferent = .Cells(.Rows.Count, 1).End(xlUp).Offset(-1).Value
If FirstDifferent = .Cells(.Rows.Count, 1) Then FirstDifferent = "#N/A"
.ClearContents
End With
End With
End Function
Public Function FirstDifferent(rng As Range) As Variant
With rng.Resize(, 1)
.AutoFilter Field:=1, Criteria1:=.Cells(.Rows.Count, 1)
FirstDifferent = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Offset(-1).Value ' = 0 '<-- if any rows filtered other than headers one then change their column "B" value to zero
If FirstDifferent = .Cells(.Rows.Count, 1) Then FirstDifferent = "#N/A"
.Parent.AutoFilterMode = False
End With
End Function
I am trying to search through a selection from a table, find a value and then return a specific result.
The conditions I am trying are:
IF 'Name' = blank, return "N / A".
IF 'Result' = blank, OR "N/A", return "N / A".
IF 'Count' = 0, return "No", ELSE "Yes".
The code I have tried so far is as follows:
Sub DoStuffIfNotEmpty()
Set M = Selection
If Not IsEmpty(M) Then
MsgBox "I'm not empty!"
Else
MsgBox "Empty Value"
End If
End Sub
Also for reference, here is the test table I have created:
Reference Image
Test() sets up the worksheet and cells to examine -- if you want to work down a list of cells you can do it here -- and calls DoStuffIfNotEmpty, which examines the Name, Result and Count columns in order. Its not even close to being elegant but there you go...
Sub Test()
Dim cWorksheet As Worksheet
Dim CRange As Range
Set cWorksheet = ActiveWorkbook.Sheets("Sheet1")
Set CRange = cWorksheet.Range("A2:C2")
MsgBox DoStuffIfNotEmpty(cWorksheet, CRange), vbOKOnly
End Sub
Function DoStuffIfNotEmpty(CurrWorksheet As Worksheet, CurrRange As Range) As String
CurrWorksheet.Select
CurrRange.Select
Set m = Selection
If m.Cells(1, 1) = "" Or IsNull(m.Cells(1, 1)) Then
retmsg = "N/A"
Else
If m.Cells(1, 2) = "" Or IsNull(m.Cells(1, 2)) Or m.Cells(1, 2) = "N/A" Then
retmsg = "N/A"
Else
If m.Cells(1, 3) = 0 Then
retmsg = "No"
Else
retmsg = "Yes"
End If
End If
End If
DoStuffIfNotEmpty = retmsg
End Function
This is what the theoretical Excel syntax would look like if it were possible to execute this without VBA:
IF(Cell to immediate left = colored (or filled), copy & paste contents into this cell, copy & paste contents of cell above into this cell).
How would I do this in VBA?
You'll have to write the surrounding code to loop through the cells you want to evaluate, but the crux of it would be something like this:
If Range("A2").Interior.ColorIndex > xlNone Then
Range("B2") = Range("A2").Value
Else
Range("B1") = Range("A2").Value
End If
The loop could be a For loop, maybe something like:
For i = 2 to <whatever>
If Range("A" & i).Interior.ColorIndex > xlNone Then
Range("B" & i) = Range("A" & i).Value
Else
Range("B" & i - 1) = Range("A" & i).Value
End If
Next i
You can use a UDF in the VBA:
Function Color(MyCell As Range)
If MyCell.Interior.ColorIndex > 0 Then
Result = 1
Else
Result = 0
End If
Color = Result
End Function
and then use the following formula in B2 to fill down the cells:
=IF(color(A2)=1,A2,B1)
hope this works for you.
As a UDF inputting the Cell to evaluate fill:
Function CellColored(rng As Range) As Variant
If rng.Interior.ColorIndex > xlNone Then
CellColored = rng.Value2
Else
CellColored = Empty
End If
End Function
As UDF without input, just assuming criteria cell is to the right of calling cell:
Function CellColored() As Variant
If Application.Caller.Offset(0, 1).Interior.ColorIndex > xlNone Then
CellColored = Application.Caller.Offset(0, 1).Value2
Else
CellColored = Empty
End If
End Function
You would then call the function as CellColored(A2) or CellColored() in the second version. Cheers,
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