I'm pretty new to vba, but I do have some working code right now. I execute this code and it clears out cells on one sheet, references an assembly number on that sheet, searches through another sheet for that assembly number, copies the data I want relevant to that assembly number, and pastes in on the original sheet.
This works for the assembly number of interest when there is exactly one assembly number per cell in the spreadsheet database the code looks through. However, if the assembly number doesn't match the cell's exact value (which happens if there are multiple assemblies per cell) then the code passes up that cell and doesn't paste the relevant data.
Is there some way to look within a cell and have the macro recognize whether the assembly number is within an array of assembly numbers within a cell?
Is there a quick way to change the "If Sheets("Stencils").Cells(i, 8).Value = assembly Then" line so that it doesn't need an exact value?
Sub findstencil()
'1. declare variables
'2. clear old search results
'3. find records that match search criteria and paste them
Dim assembly As String 'Assembly number of interest, containts numbers, letters and dashes
Dim finalrow As Integer 'determines last row in database
Dim i As Integer 'row counter
'clears destination cells
Sheets("Search").Range("A7:H15").ClearContents
assembly = Sheets("Search").Range("A5").Value
finalrow = Sheets("Stencils").Range("C5000").End(xlUp).Row
For i = 5 To finalrow
If Sheets("Stencils").Cells(i, 8).Value = assembly Then
Sheets("Stencils").Cells(i, 3).Resize(1, 6).Copy
Sheets("Search").Range("B15").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next i
Sheets("Search").Range("A5").Select
End Sub
Take your pick...
Like Operator
If Cells(i, 3).Value Like "*" & AssemblyNumber & "*" Then
module level statements...
Case-Sensitive
Option Compare Binary
Case-Insensitive
Option Compare Text
InStr
Case-Sensitive
If InStr(1, Cells(i, 3).Value2, AssemblyNumber, 0) > 0 Then
Case-Insensitive
If InStr(1, Cells(i, 3).Value2, AssemblyNumber, 1) > 0 Then
Find method
Set SearchRange = Range(Cells(5, 3), Cells(finalrow, 3))
Set cl = SearchRange.Find( _
What:=AssemblyNumber, _
After:=SearchRange.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not cl Is Nothing Then
Sheets("Stencils").Cells(cl.Row, 3).Resize(1, 6).Copy
Sheets("Search").Range("B15").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Regex
Regex for when it gets real complicated
How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops
Custom Character Analysis
You could even do a character by character comparison if you wanted. I've done this before to implement statistics and find approximate/best-guess matches.
Here's an example the shows how to make a function like InStr that allows for a tolerance in matching...
Function InStrTolerant(InputString As String, MatchString As String, Optional CaseInsensitiveChoice = False, Optional Tolerance As Integer = 0) As Integer
'Similar to InStr, but allows for a tolerance in matching
Dim ApxStr As String 'Approximate String to Construct
Dim j As Integer 'Match string index
j = 1
Dim Strikes As Integer
Dim FoundIdx As Integer
For i = 1 To Len(InputString)
'We can exit early if a match has been found
If StringsMatch(ApxStr, MatchString, CaseInsensitiveChoice) Then
InStrTolerant = FoundIdx
Exit Function
End If
If StringsMatch(Mid(InputString, i, 1), Mid(MatchString, j, 1), CaseInsensitiveChoice) Then
'This character matches, continue constructing
ApxStr = ApxStr + Mid(InputString, i, 1)
j = j + 1
FoundIdx = i
Else
'This character doesn't match
'Substitute with matching value and continue constructing
ApxStr = ApxStr + Mid(MatchString, j, 1)
j = j + 1
'Since it didn't match, take a strike
Strikes = Strikes + 1
End If
If Strikes > Tolerance Then
'Strikes exceed tolerance, reset contruction
ApxStr = ""
j = 1
Strikes = 0
i = i - Tolerance
End If
Next
If StringsMatch(ApxStr, MatchString, CaseInsensitiveChoice) Then
InStrTolerant = FoundIdx
Else
InStrTolerant = 0
End If
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
How can I find the last row that contains data in a specific column and on a specific sheet?
How about:
Function GetLastRow(strSheet, strColumn) As Long
Dim MyRange As Range
Set MyRange = Worksheets(strSheet).Range(strColumn & "1")
GetLastRow = Cells(Rows.Count, MyRange.Column).End(xlUp).Row
End Function
Regarding a comment, this will return the row number of the last cell even when only a single cell in the last row has data:
Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
You should use the .End(xlup) but instead of using 65536 you might want to use:
sheetvar.Rows.Count
That way it works for Excel 2007 which I believe has more than 65536 rows
Simple and quick:
Dim lastRow as long
Range("A1").select
lastRow = Cells.Find("*",SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row
Example use:
cells(lastRow,1)="Ultima Linha, Last Row. Youpi!!!!"
'or
Range("A" & lastRow).Value = "FIM, THE END"
function LastRowIndex(byval w as worksheet, byval col as variant) as long
dim r as range
set r = application.intersect(w.usedrange, w.columns(col))
if not r is nothing then
set r = r.cells(r.cells.count)
if isempty(r.value) then
LastRowIndex = r.end(xlup).row
else
LastRowIndex = r.row
end if
end if
end function
Usage:
? LastRowIndex(ActiveSheet, 5)
? LastRowIndex(ActiveSheet, "AI")
Public Function LastData(rCol As Range) As Range
Set LastData = rCol.Find("*", rCol.Cells(1), , , , xlPrevious)
End Function
Usage: ?lastdata(activecell.EntireColumn).Address
All the solutions relying on built-in behaviors (like .Find and .End) have limitations that are not well-documented (see my other answer for details).
I needed something that:
Finds the last non-empty cell (i.e. that has any formula or value, even if it's an empty string) in a specific column
Relies on primitives with well-defined behavior
Works reliably with autofilters and user modifications
Runs as fast as possible on 10,000 rows (to be run in a Worksheet_Change handler without feeling sluggish)
...with performance not falling off a cliff with accidental data or formatting put at the very end of the sheet (at ~1M rows)
The solution below:
Uses UsedRange to find the upper bound for the row number (to make the search for the true "last row" fast in the common case where it's close to the end of the used range);
Goes backwards to find the row with data in the given column;
...using VBA arrays to avoid accessing each row individually (in case there are many rows in the UsedRange we need to skip)
(No tests, sorry)
' Returns the 1-based row number of the last row having a non-empty value in the given column (0 if the whole column is empty)
Private Function getLastNonblankRowInColumn(ws As Worksheet, colNo As Integer) As Long
' Force Excel to recalculate the "last cell" (the one you land on after CTRL+END) / "used range"
' and get the index of the row containing the "last cell". This is reasonably fast (~1 ms/10000 rows of a used range)
Dim lastRow As Long: lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row - 1 ' 0-based
' Since the "last cell" is not necessarily the one we're looking for (it may be in a different column, have some
' formatting applied but no value, etc), we loop backward from the last row towards the top of the sheet).
Dim wholeRng As Range: Set wholeRng = ws.Columns(colNo)
' Since accessing cells one by one is slower than reading a block of cells into a VBA array and looping through the array,
' we process in chunks of increasing size, starting with 1 cell and doubling the size on each iteration, until MAX_CHUNK_SIZE is reached.
' In pathological cases where Excel thinks all the ~1M rows are in the used range, this will take around 100ms.
' Yet in a normal case where one of the few last rows contains the cell we're looking for, we don't read too many cells.
Const MAX_CHUNK_SIZE = 2 ^ 10 ' (using large chunks gives no performance advantage, but uses more memory)
Dim chunkSize As Long: chunkSize = 1
Dim startOffset As Long: startOffset = lastRow + 1 ' 0-based
Do ' Loop invariant: startOffset>=0 and all rows after startOffset are blank (i.e. wholeRng.Rows(i+1) for i>=startOffset)
startOffset = IIf(startOffset - chunkSize >= 0, startOffset - chunkSize, 0)
' Fill `vals(1 To chunkSize, 1 To 1)` with column's rows indexed `[startOffset+1 .. startOffset+chunkSize]` (1-based, inclusive)
Dim chunkRng As Range: Set chunkRng = wholeRng.Resize(chunkSize).Offset(startOffset)
Dim vals() As Variant
If chunkSize > 1 Then
vals = chunkRng.Value2
Else ' reading a 1-cell range requires special handling <http://www.cpearson.com/excel/ArraysAndRanges.aspx>
ReDim vals(1 To 1, 1 To 1)
vals(1, 1) = chunkRng.Value2
End If
Dim i As Long
For i = UBound(vals, 1) To LBound(vals, 1) Step -1
If Not IsEmpty(vals(i, 1)) Then
getLastNonblankRowInColumn = startOffset + i
Exit Function
End If
Next i
If chunkSize < MAX_CHUNK_SIZE Then chunkSize = chunkSize * 2
Loop While startOffset > 0
getLastNonblankRowInColumn = 0
End Function
Here's a solution for finding the last row, last column, or last cell. It addresses the A1 R1C1 Reference Style dilemma for the column it finds. Wish I could give credit, but can't find/remember where I got it from, so "Thanks!" to whoever it was that posted the original code somewhere out there.
Sub Macro1
Sheets("Sheet1").Select
MsgBox "The last row found is: " & Last(1, ActiveSheet.Cells)
MsgBox "The last column (R1C1) found is: " & Last(2, ActiveSheet.Cells)
MsgBox "The last cell found is: " & Last(3, ActiveSheet.Cells)
MsgBox "The last column (A1) found is: " & Last(4, ActiveSheet.Cells)
End Sub
Function Last(choice As Integer, rng As Range)
' 1 = last row
' 2 = last column (R1C1)
' 3 = last cell
' 4 = last column (A1)
Dim lrw As Long
Dim lcol As Integer
Select Case choice
Case 1:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
Case 2:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Case 3:
On Error Resume Next
lrw = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lcol = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Last = Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
Last = rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0
Case 4:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Last = R1C1converter("R1C" & Last, 1)
For i = 1 To Len(Last)
s = Mid(Last, i, 1)
If Not s Like "#" Then s1 = s1 & s
Next i
Last = s1
End Select
End Function
Function R1C1converter(Address As String, Optional R1C1_output As Integer, Optional RefCell As Range) As String
'Converts input address to either A1 or R1C1 style reference relative to RefCell
'If R1C1_output is xlR1C1, then result is R1C1 style reference.
'If R1C1_output is xlA1 (or missing), then return A1 style reference.
'If RefCell is missing, then the address is relative to the active cell
'If there is an error in conversion, the function returns the input Address string
Dim x As Variant
If RefCell Is Nothing Then Set RefCell = ActiveCell
If R1C1_output = xlR1C1 Then
x = Application.ConvertFormula(Address, xlA1, xlR1C1, , RefCell) 'Convert A1 to R1C1
Else
x = Application.ConvertFormula(Address, xlR1C1, xlA1, , RefCell) 'Convert R1C1 to A1
End If
If IsError(x) Then
R1C1converter = Address
Else
'If input address is A1 reference and A1 is requested output, then Application.ConvertFormula
'surrounds the address in single quotes.
If Right(x, 1) = "'" Then
R1C1converter = Mid(x, 2, Len(x) - 2)
Else
x = Application.Substitute(x, "$", "")
R1C1converter = x
End If
End If
End Function
I would like to add one more reliable way using UsedRange to find the last used row:
lastRow = Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count - 1
Similarly to find the last used column you can see this
Result in Immediate Window:
?Sheet1.UsedRange.Row+Sheet1.UsedRange.Rows.Count-1
21
Public Function GetLastRow(ByVal SheetName As String) As Integer
Dim sht As Worksheet
Dim FirstUsedRow As Integer 'the first row of UsedRange
Dim UsedRows As Integer ' number of rows used
Set sht = Sheets(SheetName)
''UsedRange.Rows.Count for the empty sheet is 1
UsedRows = sht.UsedRange.Rows.Count
FirstUsedRow = sht.UsedRange.Row
GetLastRow = FirstUsedRow + UsedRows - 1
Set sht = Nothing
End Function
sheet.UsedRange.Rows.Count: retrurn number of rows used, not include empty row above the first row used
if row 1 is empty, and the last used row is 10, UsedRange.Rows.Count will return 9, not 10.
This function calculate the first row number of UsedRange plus number of UsedRange rows.
Last_Row = Range("A1").End(xlDown).Row
Just to verify, let's say you want to print the row number of the last row with the data in cell C1.
Range("C1").Select
Last_Row = Range("A1").End(xlDown).Row
ActiveCell.FormulaR1C1 = Last_Row
get last non-empty row using binary search
returns correct value event though there are hidden values
may returns incorrect value if there are empty cells before last non-empty cells (e.g. row 5 is empty, but row 10 is last non-empty row)
Function getLastRow(col As String, ws As Worksheet) As Long
Dim lastNonEmptyRow As Long
lastNonEmptyRow = 1
Dim lastEmptyRow As Long
lastEmptyRow = ws.Rows.Count + 1
Dim nextTestedRow As Long
Do While (lastEmptyRow - lastNonEmptyRow > 1)
nextTestedRow = Application.WorksheetFunction.Ceiling _
(lastNonEmptyRow + (lastEmptyRow - lastNonEmptyRow) / 2, 1)
If (IsEmpty(ws.Range(col & nextTestedRow))) Then
lastEmptyRow = nextTestedRow
Else
lastNonEmptyRow = nextTestedRow
End If
Loop
getLastRow = lastNonEmptyRow
End Function
Function LastRow(rng As Range) As Long
Dim iRowN As Long
Dim iRowI As Long
Dim iColN As Integer
Dim iColI As Integer
iRowN = 0
iColN = rng.Columns.count
For iColI = 1 To iColN
iRowI = rng.Columns(iColI).Offset(65536 - rng.Row, 0).End(xlUp).Row
If iRowI > iRowN Then iRowN = iRowI
Next
LastRow = iRowN
End Function
Sub test()
MsgBox Worksheets("sheet_name").Range("A65536").End(xlUp).Row
End Sub
This is looking for a value in column A because of "A65536".
The first line moves the cursor to the last non-empty row in the column. The second line prints that columns row.
Selection.End(xlDown).Select
MsgBox(ActiveCell.Row)
*Edited To Add: Current error I'm receiving. See bottom of this post for screenshot.
I have text in column D. The macro should find blank cells, and then concatenate the text from all cells below it.
Example
Text starting in D2, displaying like this...
Blank Cell
SampleText1
SampleText2
SampleText3
Blank Cell
SampleText4
SampleText5
SampleText6
The macro should display the text in D2...
SampleText1, SampleText2, SampleText3
and then in D6, like this...
SampleText4, SampleText5, SampleText6
..and so on.
This only needs to work in column D, so I'm guessing I can write it to that range.
The closest answer I've come across is here:
Excel Macro to concatenate
Here is the code I'm currently working with...
Sub ConcatColumns()
Do While ActiveCell <> "" 'Loops until the active cell is blank.
'The "&" must have a space on both sides or it will be
'treated as a variable type of long integer.
ActiveCell.Offset(0, 1).FormulaR1C1 = _
ActiveCell.Offset(0, -1) & " " & ActiveCell.Offset(0, 0)
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Edit: Now using great code from #jeeped but receiving an error, seen in the below screenshot
Start from the bottom and work up, building an array of the strings. When you reach a blank cell, Join the strings using your preferred deliminator.
Sub build_StringLists()
Dim rw As Long, v As Long, vTMP As Variant, vSTRs() As Variant
Dim bReversedOrder As Boolean, dDeleteSourceRows As Boolean
ReDim vSTRs(0)
bReversedOrder = False
dDeleteSourceRows = True
With Worksheets("Sheet4")
For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If IsEmpty(.Cells(rw, 1)) Then
ReDim Preserve vSTRs(0 To UBound(vSTRs) - 1)
If Not bReversedOrder Then
For v = LBound(vSTRs) To UBound(vSTRs) / 2
vTMP = vSTRs(UBound(vSTRs) - v)
vSTRs(UBound(vSTRs) - v) = vSTRs(v)
vSTRs(v) = vTMP
Next v
End If
.Cells(rw, 1) = Join(vSTRs, ", ")
.Cells(rw, 1).Font.Color = vbBlue
If dDeleteSourceRows Then _
.Cells(rw, 1).Offset(1, 0).Resize(UBound(vSTRs) + 1, 1).EntireRow.Delete
ReDim vSTRs(0)
Else
vSTRs(UBound(vSTRs)) = .Cells(rw, 1).Value2
ReDim Preserve vSTRs(0 To UBound(vSTRs) + 1)
End If
Next rw
End With
End Sub
I've left options for reversing the string list as well as removing the original rows of strings.
Before build_StringLists procedure
After build_StringLists procedure
Sub BatchCopyTextNewColumn()
Dim LastRow As Integer
'Variables declared as per Solution from http://stackoverflow.com/questions/24967189 /vba-'decimal-issue-after-replacing-a-hyphen-with-dot
'by Jagadish Dabbiru (July 25, 2014)
Dim i As Integer
Dim BatchNo() As String
Dim ArrBatchNo As Long
Worksheets("DataFile").Activate
Cells(1, 17).Select
'Rename Columns
Cells(1, 17).Value = "BatchNumeric"
Cells(1, 18).Select
'Rename Columns
Cells(1, 18).Value = "BatchCheck_Old_New"
'Ask user to provide you with the Batch# from the last data set e.g. which was received a week ago.
'Last Row is defined by the Column 1 "AccountString"
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Range("O2", Range("O1").End(xlDown))
.Copy
End With
'Use the PasteSpecial method:
Range("Q2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Solution from http://stackoverflow.com/questions/24967189/vba-decimal-issue-after-'replacing-a-hyphen-with-dot
'by Jagadish Dabbiru (July 25, 2014)
'Take each value from column q and Split the batch code with delimiter hyphen(-).
'Then check the length of the value of 2nd array element.
'If length is 1 digit then add 0 as prefix else keep as it is.
i = 1
Do
BatchNo = Worksheets("DataFile").Range("Q" & i).Value
ArrBatchNo = Split(BatchNo, "-")
If Len(ArrBatchNo(1)) = 1 Then
ArrBatchNo = "0" & ArrBatchNo
End If
Worksheets("DataFile").Range("Q" & i).Value = ArrBatchNo(0) & "." & ArrBatchNo(1)
i = i + 1
Loop While Worksheets("DataFile").Range("Q" & i).Value <> ""
Range("Q2").Activate
End Sub
There is a problem with decimals after replacing hyphens with dots.
Originally the Batch numbers are issued with hyphens. I need to use them as values as I have to distinguish between "OLD" Batch numbers (sent previously) and "NEW" (larger than the last Batch number).
Hyphen replacement (my code):
Sub ReplaceBatchCharacter()
Range("Q2").Activate
Worksheets("DataFile").Columns("Q").Replace _
'I tried to replace it with "." and there is a problem with decimals as well (e.g. batch # 4230-1 and 4230-10 are both shown as 4210.10 after replacement
What:="-", Replacement:=".0", _
'by replacing with ".0" I have solution for batch #'s xxxx-1/2/3/4/5/6/7/8/9 but when it starts with double digits xxxx-10 etc I have similar problem as they become xxxx.010 etc.
So the batch number 4230-1 and 4230-10 are both shown as 4210.010 after replacement.
SearchOrder:=xlByColumns, MatchCase:=True
End Sub
Check Old and New Batch # (my code):
Sub BatchNumberCheckNewOld()
Dim BatchNumberPrevious As Single
Dim BatchNumberCurrentCell As Range
Dim BatchNumberCurrentRange As Range
Dim BatchNumberCurrentResult As String
Dim LastRow As Long
'Dim ChangedRange As Range
Worksheets("DataFile").Activate
Range("Q2").Activate
LastRow = Cells(Rows.Count, 17).End(xlUp).Row
'Ask user to provide us with the Batch# from the last data set e.g. which was received a week ago.
'Last Row is defined by the Column 1 "AccountString"
'BatchNumberPrevious = 4250.1
BatchNumberPrevious = InputBox("Please enter the last Batch # from previous period. Don't forget to reconcile TB's (prior and current months). Ocassionally OLD batches could be NEW.")
Set BatchNumberCurrentRange = Range(Cells(2, 17), Cells(LastRow, 17))
For Each BatchNumberCurrentCell In BatchNumberCurrentRange
If BatchNumberPrevious >= BatchNumberCurrentCell.Value Then
BatchNumberCurrentResult = "Old"
Else
BatchNumberCurrentResult = "New"
End If
'BatchNumberCurrentResult column should be populated by offsetting BatchNumberCurrentCell variable
BatchNumberCurrentCell.Offset(0, 1).Value = BatchNumberCurrentResult
Next BatchNumberCurrentCell
'Autofit width of columns
ActiveSheet.UsedRange.Columns.AutoFit
End Sub
Take each value from column q and Split the batch code with delimiter hyphen(-). Then check the length of the value of 2nd array element. If length is 1 digit then add 0 as prefix else keep as it is.
i =1
Do
BatchNo = Worksheets("DataFile").Range("Q"& i).Value
ArrBatchNo = Split(BatchNo,"-")
If Len(ArrBatchNo(1)) = 1 Then
ArrBatchNo(1) = "0" & ArrBatchNo (1)
End If
Worksheets("DataFile").Range("Q"& i).Value = ArrBatchNo(0) & "." & ArrBatchNo(1)
i = i+1
Loop While Worksheets("DataFile").Range("Q"& i).Value <> ""
I have an excel sheet, where cells A1-C20==INT(RAND()*10). This is my data range. Cell E1=1, E2=2, E3=3, etc. These are the values I am trying to find. I set cell F1==MATCH(E1,A:C,0), F2==MATCH(E1,A:C,0), etc.
However, all the MATCH functions return #N/A, because the input range is multi-dimensional. How can I test whether a given value (1, 2, 3, 4, etc.) exists in a multidimensional range (A1-C20)?
/edit: This function works, but is more than I need. Is there any way to make it return just TRUE or FALSE, depending on if the lookup value is in the range?
Function OzgridLookup(Find_Val As Variant, Occurrence As Long, Table_Range As Range, _
Offset_Cols As Long, Optional Column_Lookin As Long, Optional Row_Offset As Long) As Variant
Dim lLoop As Long
Dim FoundCell As Range
If Column_Lookin = 0 Then 'No column # specified
With Table_Range
'Top left cell has Find_Val & Occurrence is 1
If Table_Range.Cells(1, 1) = Find_Val And Occurrence = 1 Then
OzgridLookup = .Cells(1, 1)(1, Offset_Cols + 1)
Exit Function 'All done :)
Else 'No column # specified so search all for _
nth Occurrence reading left to right
Set FoundCell = .Cells(1, 1) 'Set cell variable for Find start
For lLoop = 1 To Occurrence 'Loop as many times as Occurrences _
and each time Set "FoundCell" to start next Find from
Set FoundCell = _
Table_Range.Find(What:=Find_Val, After:=FoundCell, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlRows, SearchDirection:=xlNext)
Next lLoop
End If
End With
Else 'column # specified
With Table_Range.Columns(Column_Lookin) 'Work with column # specified
Set FoundCell = .Cells(1, 1) 'Set cell variable for Find start
For lLoop = 1 To Occurrence 'Loop as many times as Occurrences _
and each time Set "FoundCell" to start next Find from
Set FoundCell = _
Table_Range.Find(What:=Find_Val, After:=FoundCell, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlRows, SearchDirection:=xlNext)
Next lLoop
End With
End If
OzgridLookup = FoundCell.Offset(Row_Offset, Offset_Cols)
End Function
You can use COUNTIF to do this since you only want to know whether the number is present (not its location).
=COUNTIF(A:C,E1)>0
This will return "TRUE" if it is present, "FALSE" if it is not.
Just for fun, here's a worksheet function solution that returns the cell address that matches the lookup value. It uses the fact that you are only searching in 3 columns.
=IF(ISERROR(MATCH(E1,A:A,0)),IF(ISERROR(MATCH(E1,B:B,0)),IF(ISERROR(MATCH(E1,C:C,0)),"Not found.","C"&MATCH(E1,C:C,0)),"B"&MATCH(E1,B:B,0)),"A"&MATCH(E1,A:A,0))
I thought I'd also throw in a VBA solution that can return the match location inside a (contiguous) range. It looks at columns one at a time from left to right and returns the address of the first match found.
Public Function MDMATCH(srchfor As String, lookin As Range) As String
Application.Volatile
Dim RngArray() As Variant
Dim topleft As String
Dim tmpval As String
topleft = lookin.Address
topleft = Left(topleft, InStr(topleft, ":") - 1)
tmpval = "Not found."
RngArray = lookin
For i = 1 To UBound(RngArray, 2)
If tmpval = "Not found." Then
For j = 1 To UBound(RngArray, 1)
If RngArray(j, i) = srchfor Then
tmpval = Range(topleft).Offset(j - 1, i - 1).Address
Exit For
End If
Next j
Else
Exit For
End If
Next i
MDMATCH = tmpval
End Function