Excel VBA, nested loops / hide rows based on numbers - vba

Dear stackoverflow community
At work I have to write a macro which should be able to hide rows based on numbers in a column. Those can be multiple ones in one cell and the input should also allow to show more than one number at a time.
for example:
row 1: 20, 30, 15
row 2: 20
row 3: 13, 76
So if I enter 20, 30, it should only show rows 1 & 2)
I usually code with Java / c# and Im new to VBA, so Id really appreciate help:
My plan was to show a input box and split those numbers into an array.
Then i wanna go through each row with a for-Loop, in which i added two for each loops to check if any numbers equal. If not, hide row. If so, show and then i want to exit both for each loops and go to the next row. To exit nested loops, i tried using a do while boolean but it doesnt seem to work.
Right now it only shows the rows with all the input numbers (only row1 in example).
Sub SortingTest()
Dim numbers() As String
myNum = Application.InputBox("Enter BKPS (separate multiples by , )")
numbers = Split(myNum, ",", -1, compare)
'Userinput Vars
Dim row As Integer
row = 1
Dim saveNumber As String
'Looping Vars
Dim existingNum As String
Dim existingNumsArray() As String
Dim checkRows As Long
Dim saveElement As String
Dim done As Boolean
done = False
' Range("B3").Value = 10
' Saves the Input as Array:
For Each Element In numbers
saveNumber = Element
Cells(2, row).Value = saveNumber
row = row + 1
Next Element
Dim b As Integer
Do While done = False
For b = 1 To 100 'hardcoded, should be length of document. b == row;
existingNum = Cells(b, 3).Value
existingNumsArray = Split(existingNum, ",", -1, compare)
' loop thru input numbers
For Each Element In numbers
saveElement = Element
'loop thru given numbers
For Each inputElement In existingNumsArray
If saveElement <> inputElement Then
Rows(b).Hidden = True
ElseIf saveElement = inputElement Then
Rows(b).Hidden = False
done = True
Exit For
End If
Next
Next
Next
Loop
End Sub

Thank you very much for you answer. Yours hid all the rows, so i adjusted it to show them.
Option Explicit
Function ArrOr(a As Variant, b As Variant) As Boolean
Dim runner As Variant
ArrOr = True
If IsArray(a) Then
For Each runner In a
If ArrOr(runner, b) Then Exit Function
Next
Else
For Each runner In b
If Trim(a) = Trim(runner) Then Exit Function
Next
End If
ArrOr = False
End Function
Sub SortingBKPS()
Dim numbers As Variant, vars As Variant, i As Long, xRows As Range
numbers = Split(Application.InputBox("Enter BKPS (separate multiples by , )"), ",")
With Sheets("Sheet1")
vars = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Value2
For i = 2 To UBound(vars)
.Rows(i).EntireRow.Hidden = True
If ArrOr(Split(vars(i, 1), ","), numbers) Then
If xRows Is Nothing Then
Set xRows = .Rows(i)
Else
Set xRows = Union(xRows, .Rows(i))
End If
End If
Next
xRows.EntireRow.Hidden = False
End With
End Sub

By splitting it up it is very easy to do:
Option Explicit
Function ArrOr(a As Variant, b As Variant) As Boolean
Dim runner As Variant
ArrOr = True
If IsArray(a) Then
For Each runner In a
If ArrOr(runner, b) Then Exit Function
Next
Else
For Each runner In b
If Trim(a) = Trim(runner) Then Exit Function
Next
End If
ArrOr = False
End Function
Sub SortingTest()
Dim numbers As Variant, vars As Variant, i As Long, xRows As Range
numbers = Split(Application.InputBox("Enter BKPS (separate multiples by , )"), ",")
With Sheets("Sheet1")
vars = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Value2
For i = 1 To UBound(vars)
If ArrOr(Split(vars(i, 1), ","), numbers) Then
If xRows Is Nothing Then
Set xRows = .Rows(i)
Else
Set xRows = Union(xRows, .Rows(i))
End If
End If
Next
xRows.EntireRow.Hidden = True
End With
End Sub
by running this code line by line, it should be pretty much self explaining (also knowing you have already some knowledge in "coding")
Still, if you have any questions, just ask ;)

You can also do it the following way:
Sub SortingTest()
Dim numbers As Variant
Dim RangeCompare As Range
Dim MyRow As Integer
Dim NumFound As Boolean
numbers = Application.InputBox("Please,list the values in this format: " & _
vbCrLf & "{value, value, value, ...}", _
Default:="{#, #, #}", Type:=64)
For MyRow = 1 To Cells(Rows.Count, 1).End(xlUp).row
Set RangeCompare = Range(Cells(MyRow, 1), Cells(MyRow, Columns.Count).End(xlToLeft))
NumFound = False
For Each rCell In RangeCompare
For Each Element In numbers
If rCell = Element Then
NumFound = True
Exit For
End If
Next Element
If NumFound = True Then Exit For
Next rCell
If NumFound = False Then
Rows(MyRow).Hidden = True
End If
Next MyRow
End Sub
I think it's easy to understand but feel free to ask for explanation.

Related

Format cells with the same values split by a delimiter, but a different order in VBA

I am a VBA beginner, who cannot seem to find a solution to what seemed to be a very easy comparison to me at first.
Basically, I have 2 columns where the values in the cells are split by a delimiter, however, not in the same order.
eg.
Range("A1").value = "1234|5678"
Range("B1").value = "5678|1234"
B1 should then be highlighted as a duplicate
I am searching for some vba code which I can use to loop through the used range's in Columns A & B, to compare and highlight cells in column B that are duplicated, as per example above.
Apologies if I missed any similar questions asked and answered previously, I have indeed conducted a search but perhaps my search criteria may have been out of bounds, and I simply did not come across the VBA solution.
Regards,
Enjay
Based on the little information given you could try the following code
Sub Highlight()
Const DELIMITER = "|"
Dim rg As Range
Dim a As Variant
Dim b As Variant
Dim sngCell As Range
Set rg = Range("A1:A3")
For Each sngCell In rg
a = Split(sngCell.Value2, DELIMITER)
b = Split(sngCell.Offset(, 1).Value2, DELIMITER)
If isEqual(a, b) Then
With sngCell.Offset(, 1).Interior
.ThemeColor = xlThemeColorAccent6
End With
End If
Next sngCell
End Sub
with the following functions
Function isEqual(a As Variant, b As Variant) As Boolean
a = BubbleSort(a)
b = BubbleSort(b)
isEqual = True
Dim i As Long
For i = LBound(a) To UBound(a)
If a(i) <> b(i) Then
isEqual = False
Exit For
End If
Next i
End Function
Function BubbleSort(ByRef strArray As Variant) As Variant
'sortieren von String Array
'eindimensionale Array
'Bubble-Sortier-Verfahren
Dim z As Long
Dim i As Long
Dim strWert As Variant
For z = UBound(strArray) - 1 To LBound(strArray) Step -1
For i = LBound(strArray) To z
If LCase(strArray(i)) > LCase(strArray(i + 1)) Then
strWert = strArray(i)
strArray(i) = strArray(i + 1)
strArray(i + 1) = strWert
End If
Next i
Next z
BubbleSort = strArray
End Function
This will answer your question as-is. If the solution needs to be adjusted, I trust that you can fix it :)
This uses StrComp to (in memory only) re-order the two string parts so that it can easily detect duplicate values.
Option Explicit
Sub DuplicateCheck()
Dim delimiter As String
delimiter = "|"
Dim lastCol As Long
lastCol = Cells(1, Columns.count).End(xlToLeft).Column
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 1 To lastCol
Dim theSplit As Variant
theSplit = Split(Cells(1, i), delimiter)
Dim temp As String
If StrComp(theSplit(0), theSplit(1), vbTextCompare) = 1 Then
temp = theSplit(1)
theSplit(1) = theSplit(0)
theSplit(0) = temp
End If
temp = theSplit(0) & delimiter & theSplit(1)
If Not dict.exists(temp) Then
dict.Add (temp), 1
Else
Cells(1, i).Interior.color = 65535
End If
Next i
End Sub

VBA for Excel code to find and change formatting of substrings of text within a cell

I'm using VBA for Excel.
I have code that does the following:
Take an array of words (called Search_Terms)
I then have a function (see below) that receives the Search_Terms and a reference to a Cell in Excel.
The function then searches the text within the cell.
It finds all substrings that match the words in Search_Terms within the cell and changes their formatting.
The function shown below already works.
However, it is quite slow when I want to search several thousand cells with an array of 20 or 30 words.
I'm wondering if there is a more efficient/idiomatic way to do this (I'm not really familiar w/ VBA and I'm just hacking my way through).
Thank you!
Dim Search_Terms As Variant
Dim starting_numbers() As Integer ' this is an "array?" that holds the starting position of each matching substring
Dim length_numbers() As Integer 'This is an "array" that holds the length of each matching substring
Search_Terms = Array("word1", "word2", "word3")
Call change_all_matches(Search_Terms, c) ' "c" is a reference to a Cell in a Worksheet
Function change_all_matches(terms As Variant, ByRef c As Variant)
ReDim starting_numbers(1 To 1) As Integer ' reset the array
ReDim length_numbers(1 To 1) As Integer ' reset the array
response = c.Value
' This For-Loop Searches through the Text in the Cell and finds the starting position & length of each matching substring
For Each term In terms ' Iterate through each term
Start = 1
Do
pos = InStr(Start, response, term, vbTextCompare) 'See if we have a match
If pos > 0 Then
Start = pos + 1 ' keep looking for more substrings
starting_numbers(UBound(starting_numbers)) = pos
ReDim Preserve starting_numbers(1 To UBound(starting_numbers) + 1) As Integer ' Add each matching "starting position" to our array called "starting_numbers"
length_numbers(UBound(length_numbers)) = Len(term)
ReDim Preserve length_numbers(1 To UBound(length_numbers) + 1) As Integer
End If
Loop While pos > 0 ' Keep searching until we find no substring matches
Next
c.Select 'Select the cell
' This For-Loop iterates through the starting position of each substring and modifies the formatting of all matches
For i = 1 To UBound(starting_numbers)
If starting_numbers(i) > 0 Then
With ActiveCell.Characters(Start:=starting_numbers(i), Length:=length_numbers(i)).Font
.FontStyle = "Bold"
.Color = -4165632
.Size = 13
End With
End If
Next i
Erase starting_numbers
Erase length_numbers
End Function
The code bellow might be a bit faster (I haven't measured it)
What it does:
Turns off Excel features, as suggested by #Ron (ScreenUpdating, EnableEvents, Calculation)
Sets the used range and captures the last used column
Iterates through each column and applies an AutoFilter for each of the words
If there is more than one visible row (the first one being the header)
Iterates through all visible cells in currently auto-filtered column
Checks that the cell doesn't contain error & is not empty (this order, distinct checks)
When it finds the current filter word makes the changes
Moves to the next cell, then next filter word until all search words are done
Moves to the next column, repeats above process
Clears all filters, and turns Excel features back on
Option Explicit
Const ALL_WORDS = "word1,word2,word3"
Public Sub ShowMatches()
Dim ws As Worksheet, ur As Range, lc As Long, wrdArr As Variant, t As Double
t = Timer
Set ws = Sheet1
Set ur = ws.UsedRange
lc = ur.Columns.Count
wrdArr = Split(ALL_WORDS, ",")
enableXL False
Dim c As Long, w As Long, cVal As String, sz As Long, wb As String
Dim pos As Long, vr As Range, cel As Range, wrd As String
For c = 1 To lc
For w = 0 To UBound(wrdArr)
If ws.AutoFilterMode Then ur.AutoFilter 'clear filters
wrd = "*" & wrdArr(w) & "*"
ur.AutoFilter Field:=c, Criteria1:=wrd, Operator:=xlFilterValues
If ur.Columns(c).SpecialCells(xlCellTypeVisible).CountLarge > 1 Then
For Each cel In ur.Columns(c).SpecialCells(xlCellTypeVisible)
If Not IsError(cel.Value2) Then
If Len(cel.Value2) > 0 Then
cVal = cel.Value2: pos = 1
Do While pos > 0
pos = InStr(pos, cVal, wrdArr(w), vbTextCompare)
wb = Mid(cVal, pos + Len(wrdArr(w)), 1)
If pos > 0 And wb Like "[!a-zA-Z0-9]" Then
sz = Len(wrdArr(w))
With cel.Characters(Start:=pos, Length:=sz).Font
.Bold = True
.Color = -4165632
.Size = 11
End With
pos = pos + sz - 1
Else
pos = 0
End If
Loop
End If
End If
Next
End If
ur.AutoFilter 'clear filters
Next
Next
enableXL True
Debug.Print "Time: " & Format(Timer - t, "0.000") & " sec"
End Sub
Private Sub enableXL(Optional ByVal opt As Boolean = True)
Application.ScreenUpdating = opt
Application.EnableEvents = opt
Application.Calculation = IIf(opt, xlCalculationAutomatic, xlCalculationManual)
End Sub
Your code uses ReDim Preserve in the first loop (twice)
slight impact on performance for one cell, but for thousands it becomes significant
ReDim Preserve makes a copy of the initial arr with the new dimension, then deletes the first arr
Also, Selecting and Activating cells should be avoided - most of the times are not needed and slow down execution
Edit
I measured the performance between the 2 versions
Total cells: 3,060; each cell with 15 words, total search terms: 30
Initial code: Time: 69.797 sec
My Code: Time: 3.969 sec
Initial code optimized: Time: 3.438 sec
Initial code optimized:
Option Explicit
Const ALL_WORDS = "word1,word2,word3"
Public Sub TestMatches()
Dim searchTerms As Variant, cel As Range, t As Double
t = Timer
enableXL False
searchTerms = Split(ALL_WORDS, ",")
For Each cel In Sheet1.UsedRange
ChangeAllMatches searchTerms, cel
Next
enableXL True
Debug.Print "Time: " & Format(Timer - t, "0.000") & " sec"
End Sub
Public Sub ChangeAllMatches(ByRef terms As Variant, ByRef cel As Range)
Dim termStart() As Long 'this array holds starting positions of each match
Dim termLen() As Long 'this array holds lengths of each matching substring
Dim response As Variant, term As Variant, strt As Variant, pos As Long, i As Long
If IsError(cel.Value2) Then Exit Sub 'Do not process error
If Len(cel.Value2) = 0 Then Exit Sub 'Do not process empty cells
response = cel.Value2
If Len(response) > 0 Then
ReDim termStart(1 To Len(response)) As Long 'create arrays large enough
ReDim termLen(1 To Len(response)) As Long 'to accommodate any matches
i = 1: Dim wb As String
'The loop finds the starting position & length of each matched term
For Each term In terms 'Iterate through each term
strt = 1
Do
pos = InStr(strt, response, term, vbTextCompare) 'Check for match
wb = Mid(response, pos + Len(term), 1)
If pos > 0 And wb Like "[!a-zA-Z0-9]" Then
strt = pos + 1 'Keep looking for more substrings
termStart(i) = pos 'Add match starting pos to array
termLen(i) = Len(term) 'Add match len to array termLen()
i = i + 1
Else
pos = 0
End If
Loop While pos > 0 'Keep searching until we find no more matches
Next
ReDim Preserve termStart(1 To i - 1) 'clean up array
ReDim Preserve termLen(1 To i - 1) 'remove extra items at the end
For i = 1 To UBound(termStart) 'Modify matches based on termStart()
If termStart(i) > 0 Then
With cel.Characters(Start:=termStart(i), Length:=termLen(i)).Font
.Bold = True
.Color = -4165632
.Size = 11
End With
End If
Next i
End If
End Sub

Need help improving my VBA loop

I have an Excel Worksheet consisting of two columns, one of which is filled with strings and the other is emtpy. I would like to use VBA to assign the value of the cells in the empty column based on the value of the adjacent string in the other column.
I have the following code:
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
Dim j As Integer
For j = 1 To 2
If regexAdmin.test(Cells(i, j).Value) Then
Cells(i, j + 1).Value = "Exploitation"
End If
Next j
Next i
The problem is that when using this loop for a big amount of data, it takes way too long to work and, most of the time, it simply crashes Excel.
Anyone knows a better way to this?
You have an unnecessary loop, where you test the just completed column (j) too. Dropping that should improve the speed by 10-50%
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
If regexAdmin.test(Cells(i, 1).Value) Then
Cells(i, 1).offset(0,1).Value = "Exploitation"
End If
Next i
If the regex pattern really is simply "Admin", then you could also just use a worksheet formula for this, instead of writing a macro. The formula, which you'd place next to the text column (assuming your string/num col is A) would be:
=IF(NOT(ISERR(FIND("Admin",A1))),"Exploitation","")
In general, if it can be done with a formula, then you'd be better off doing it so. it's easier to maintain.
Try this:
Public Sub ProcessUsers()
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim r As Range, N As Integer, i As Integer
Set r = Range("A1") '1st row is headers
N = CountRows(r) - 1 'Count data rows
Dim inputs() As Variant, outputs() As Variant
inputs = r.Offset(1, 0).Resize(N, 1) ' Get all rows and 1 columns
ReDim outputs(1 To N, 1 To 1)
For i = 1 To N
If regexAdmin.test(inputs(i, 1)) Then
outputs(i, 1) = "Exploitation"
End If
Next i
'Output values
r.Offset(1, 1).Resize(N, 1).Value = outputs
End Sub
Public Function CountRows(ByRef r As Range) As Long
If IsEmpty(r) Then
CountRows = 0
ElseIf IsEmpty(r.Offset(1, 0)) Then
CountRows = 1
Else
CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End If
End Function

compare cell value to reference value and look for a partial match

I am looking for a method to compare a list of cell values to a certain reference value. If I would only need to compare the values I'd know how to achieve that. But here is the kicker: How can I look for a partial match? e.g.: the reference value should be "good". If the value of those cells would be "good" as well it should be considered a match. If the cell value is "Mr. goodcat" it should also be considered a match. My best guess would be to reference the original value to a string variable and put in some "*" if that would be possible.
Since I am not able to post some code, I don't need you to give me the whole answer, but a point in the right direction would be very nice. Thanks in advance guys.
edit: I have put in my final code. A short explaination: It loops through values in Sheet2 and compares them to values in column J in Sheet 1. If it finds a (partial) match, it highlights the cell.
Sub CompareValues()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws1Lrow As Long
Dim ws2Lrow As Long
Dim i As Integer
Dim x As Integer
Dim k As Integer
Dim reference As String
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
ws1Lrow = Worksheets("Sheet1").Range("A" & Worksheets("Sheet1").Rows.Count).End(xlUp).Row
ws2Lrow = Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To ws2Lrow Step 1
ws2.Select
Cells(i, 1).Select
reference = ActiveCell
ws1.Select
For x = 2 To ws1Lrow
k = InStr(1, Cells(x, 10), reference, vbTextCompare)
If k > 0 Then
Cells(x, 10).Interior.ColorIndex = 6
End If
Next x
Next i
End Sub
How about this?
Dim I As Integer
I = InStr(1, "Mr. goodcat", "good", vbTextCompare)
If I > 0 Then
' Match
Else
' No Match
End
Here's more advanced function which allows wildcards in the middle:
Function PatternMatch(ByVal SearchIn As String, ByVal Pattern As String) As Boolean
If Len(SearchIn) = 0 Or Len(Pattern) = 0 Then
PatternMatch = False
Exit Function
End If
Dim Position As Integer
Dim MatchFirst As Boolean
Dim MatchLast As Boolean
Dim Chunks() As String
MatchFirst = (Left(Pattern, 1) <> "*")
MatchLast = (Right(Pattern, 1) <> "*")
Chunks = Split(Pattern, "*")
LastChunkIndex = UBound(Chunks)
If MatchFirst Then
If Not (Left(SearchIn, Len(Chunks(0))) = Chunks(0)) Then
PatternMatch = False
Exit Function
End If
End If
If MatchLast Then
If Not (Right(SearchIn, Len(Chunks(LastChunkIndex))) = Chunks(LastChunkIndex)) Then
PatternMatch = False
Exit Function
End If
End If
Position = 1
For Each Chunk In Chunks
ChunkLength = Len(Chunk)
If ChunkLength > 0 Then
NextPosition = InStr(Position, SearchIn, Chunk, vbTextCompare)
If NextPosition > 0 And NextPosition >= Position Then
Position = NextPosition + ChunkLength
Else
PatternMatch = False
Exit Function
End If
End If
Next Chunk
PatternMatch = True
End Function

Searching over multiple columns in excel vba

I am able to search a text in column A of my spreadsheet by using this
With WB.Sheets("MySheet")
Set FindRow = .Range("A:A").Find(What:="ProjTemp1", LookIn:=xlValues)
End With
After which I can get the row number by doing FindRow.Row
How do I then get back the row number where Column A == "ProjTemp1" && Column B == "ProjTemp2" && Column C == "ProjTemp3"
Try to use Autofilter:
Dim rng As Range
'disable autofilter in case it's already enabled'
WB.Sheets("MySheet").AutoFilterMode = False
With WB.Sheets("MySheet").Range("A1:C1")
'set autofilter'
.AutoFilter Field:=1, Criteria1:="=ProjTemp1"
.AutoFilter Field:=2, Criteria1:="=ProjTemp2"
.AutoFilter Field:=3, Criteria1:="=ProjTemp3"
End With
With WB.Sheets("MySheet")
On Error Resume Next
Set rng = .Range("A2:A" & .Rows.Count).Rows.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If Not rng Is Nothing Then
MsgBox rng.Row ' returns first visible row number
End If
WB.Sheets("MySheet").AutoFilterMode = False 'disable autofilter'
An alternative suggestion is to just loop through the table and use nested if-statements like this:
Sub ReturnRowNumber()
Dim i As Long, GetRow As Long
For i = 2 To Sheets("MySheet").Cells(Rows.Count, 1).End(xlUp).Row
'Criteria search
If Sheets("MySheet").Cells(i, 1).Value = "ProjTemp1" Then
If Sheets("MySheet").Cells(i, 2).Value = "ProjTemp2" Then
If Sheets("MySheet").Cells(i, 3).Value = "ProjTemp3" Then
'Returns row
GetRow = i
End If
End If
End If
Next i
End Sub
Just posted similar reply at MSDN and wanted to share here if anyone is still using VBA. The function for multiple match that works pretty fast.
It might help a lot if you are interested in effective code since using Application.Match() is much much faster that Find() or INDEX() method or simple looping.
The syntax is the same as COUNTIFS() but it returns the match index instead of counting.
Public Function MultiMatch(ParamArray X0() As Variant) As Variant
MultiMatch = CVErr(xlErrNA)
If UBound(X0) = -1 Then Exit Function
On Error GoTo ErrorHandler
Set Xws = X0(1).Parent
X_rFrow = X0(1)(1, 1).Row
X_rLrow = X_rFrow + X0(1).Rows.Count - 1
jLAST = UBound(X0)
l = X_rFrow
j = 0
Do While IsError(MultiMatch) And j + 1 <= jLAST And Not IsError(X1)
jCOL = X0(j + 1).Column
Set TRNG = Xws.Range(Xws.Cells(l, jCOL), Xws.Cells(X_rLrow, jCOL))
X1 = Application.Match(X0(j), TRNG, 0)
If Not IsError(X1) Then
l = TRNG(X1).Row
If X1 = 1 Then
If j + 1 = jLAST Then
MultiMatch = l - X_rFrow + 1
Else
j = j + 2
End If
Else
j = 0
End If
End If
Loop
Exit Function
ErrorHandler:
MultiMatch = CVErr(xlErrName)
End Function
This can work in such a way that X amount of values ​​to search are Y columns to search for X values ​​in a row, having 0 as a result of nothing and Row>= 1 the row that has the X amount of values ​​per column in the same row.
Public Function find(sheetName As String, initCol As Integer, initRow As Integer, ParamArray values()) As Variant
Dim i As Long, GetRow As Long
On Error GoTo nextRow
For i = initRow To Sheets(sheetName).cells(Rows.Count, 1).End(xlUp).row
For ii = 0 To UBound(values)
If Sheets(sheetName).cells(i, initCol + ii).Value2 = values(ii) Then
GetRow = ii
If ii = UBound(values) Then
find = i
Exit Function
End If
GoTo nextCol
End If
If ii = 0 Then GoTo nextRow
nextCol:
Next ii
nextRow:
Next i
endFind:
find = GetRow
End Function
Use :
vRow = find("sheet", 1, 1, "test", "test1","test2")
"sheet" = sheetName, 1 = Col index start, 1 = row number start, ["test","test1","test2"] is ParamArray
"find" Function will search "test" in colunm A, "test1" in B &
"test2" in C and it will return the row number that has these values
​​followed in the same row