I'm trying to figure out how to find multiple match data from another worksheet. My goal is to find not just one match. I want to find all the matches up to the last row of data.
Here's a sample of my code. It only finds one match, then it goes to the next data.
For RowData = 2 to LastRow
MatchData = Application.WorksheetFunction.Match("Sandwich",Worksheets("Food").Range("A1:A" & LastRow), 0))
If RowData <> MatchData then
Msgbox("Data matched!")
End if
Next
Hope you could help me out. Thanks in advance.
Possibly use .findnext to make sure you search up to lastrow. Then store (as a possibility) hits in an array. Code below:
Sub Test()
Dim myArray() As Variant
Dim x As Long, y As Long
Dim msg As String
With Worksheets("Food").Range("A1:A" & Worksheets("Food").Range("A" & Rows.Count).End(xlUp).Row)
Set c = .Find("Sandwich", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
ReDim Preserve myArray(y)
myArray(y) = c.Row
y = y + 1
Set c = .FindNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstAddress
End If
DoneFinding:
End With
For x = LBound(myArray) To UBound(myArray)
msg = msg & myArray(x) & ", "
Next x
MsgBox "Matches in row(s): " & msg & " Good luck with it!"
End Sub
You could also get rid of the array and just update the variable msg each time there is a hit below Do... I just like the idea of an array :) The choice is yours!
Try,
dim MatchData as variant
For RowData = 2 to LastRow
MatchData = Application.Match("Sandwich", Worksheets("Food").Range("A" & RowData & ":A" & LastRow), 0))
if not iserror(matchdata) then
If RowData <> MatchData then
Msgbox("Data matched!")
End if
end if
Next
Related
I am looking for a code, that can find each cell that starts with the number "2347" in column L. I want to get the cell adresses for these cells and display it in a MessageBox for example "Msgbox: Cells L3500:L3722 has a value starts starts with "2347" "
Sub Findrow()
Dim MyVal As Integer
Dim LastRow As Long
MyVal = LEFT(c.Value,4) = "2347" _
LastRow = Cells(Rows.Count, "L").End(xlUp).Row
For Each c In Range("L2:L" & LastRow)
If c.Value = Myval Then
This is my code so far. Hope someone can help me!
Using arrays is quite fast
Option Explicit
Public Sub FindIDInColL()
Const VID = "2347" 'Value to find
Dim ws As Worksheet, arrCol As Variant, found As Variant
Set ws = ActiveSheet 'Or Set ws = ThisWorkbook.Worksheets("Sheet3")
arrCol = ws.Range(ws.Cells(2, "L"), ws.Cells(ws.Rows.Count, "L").End(xlUp))
ReDim found(1 To UBound(arrCol))
Dim r As Long, f As Long, msg As String
f = 1
For r = 1 To UBound(arrCol) 'Iterate vals in col L, excluding header row
If Not IsError(arrCol(r, 1)) Then 'Ignore errors
If Len(arrCol(r, 1)) > 3 Then 'Check only strings longer than 3 letters
If Left$(arrCol(r, 1), 4) = VID Then 'Check first 4 letters
found(f) = r + 1 'Capture rows containing value (header offset)
f = f + 1
End If
End If
End If
Next
If f > 1 Then 'If any cells found
ReDim Preserve found(1 To f - 1) 'Drop unused array items
msg = "Cells in col L starting with """ & VID & """" & vbNewLine & vbNewLine
MsgBox msg & " - L" & Join(found, ", L"), , "Total Found: " & f - 1
Else
MsgBox "No cells starting with """ & VID & """ found in col L", , "No matches"
End If
End Sub
Even faster when using the string versions of these functions
Left$() Mid$() Right$() Chr$() ChrW$() UCase$() LCase$()
LTrim$() RTrim$() Trim$() Space$() String$() Format$()
Hex$() Oct$() Str$() Error$
They are more efficient (if Null is not a concern), as pointed out by QHarr
You may try this:
Option Explicit
Sub Findrow()
Dim MyVal As String ' "2347" is a String
Dim LastRow As Long
Dim c As Range, myCells As Range
MyVal = "2347"
LastRow = cells(Rows.Count, "L").End(xlUp).row
Set myCells = Range("M2") 'initialize cells with a dummy cell certainly out of relevant one
For Each c In Range("L2:L" & LastRow)
If Left(c.Value2, 4) = MyVal Then Set myCells = Union(myCells, c) ' if current cell matches criteria then add it to cells
Next
If myCells.Count > 1 Then MsgBox "Cells " & Intersect(myCells, Range("L:L")).Address(False, False) & " have values starting with ‘2347’" ' if there are other cells than the dummy one then get rid of this latter and show their addresses
End Sub
I have an excel file that contains serial numbers(sn) of spare parts and production dates (pd) among many other extra data.
So far in order to find some extra data that refer to a specific sn I used the search function in excel. However a sn can have several pd and thus i had sometimes to click on the search button for more than a hundred times....
pd is always in a column on the left of the column where sn is. But there are more than 200 columns and their position isnt fixed...i.e. sometimes pd is in column 22 and sn in column 23 but sometimes pd is in column 66 and sn in column 67. Always in neighboring cells with pd on the left.
So far I have the following code:
Sub FindBoard()
Dim LastRow As Long
Dim LastColumn As Long
Dim LastCell As Range, NextCell As Range
Dim r As Long
Dim m As Long
Dim sthlh As Long
With Worksheets("Sheet3")
' Find LastRow. Works Best. 1st and last cells can be empty
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'MsgBox "Last Cell" & vbCrLf & vbCrLf & Cells(LastRow, LastColumn).Address
MsgBox "The Last Row is: " & vbCrLf & vbCrLf & LastRow
MsgBox "The Last Column is: " & vbCrLf & vbCrLf & LastColumn
End If
' Number of columns based on actual size of log range NOT MyAr(n)
Set NextCell = Worksheets("Sheet3").Cells(LastRow + 1, (LastColumn - 10))
End With
For r = 1 To LastRow
'For sthlh = 2 To LastColumn**
If Cells(r, "AP") = "0600263" Then
If Cells(r, "AO") = "4112" Then
Exit For
End If
End If
'Next sthlh**
Next r
If r > LastRow Then
MsgBox " not found"
Else
' found in row
MsgBox "The board u r looking for is in row: " & vbCrLf & vbCrLf & r
Rows(r).Select
End If
End Sub
I try to add the two lines with the double asterix ** in order not to use spcific columns like I do in my code but to have sth like this:
.....
For r = 1 To LastRow
For sthlh = 2 To LastColumn
If Cells(r, sthlh ) = "0600263" Then
If Cells(r, sthlh-1) = "4112" Then
Exit For
End If
End If
Next sthlh
Next r
.....
where 4112 is pd
and 0600263 is sn
My aim is to iterate through Iterate through every PAIR OF COLUMNS of the excel sheet and when i find the sn to check if the pd is the desired one. If yes to select the row so that i can see the extra data i want.
Any idea where I m doing it wrong???
Thanks in advance!!!
Try this:
Option Explicit
Sub FindBoard()
Dim LastRow As Long, LastColumn As Long
Dim r As Long
Dim sthlh As Long
Dim found As Boolean
Dim Paire As Range
LastRow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
LastColumn = Sheets("Sheet3").Cells(1, Columns.Count).End(xlToLeft).Column
found = False
r = 0
Do Until r > LastRow Or found = True
r = r + 1
For sthlh = 2 To LastColumn
If Cells(r, sthlh) = "0600263" Then
If Cells(r, sthlh - 1) = "4112" Then
found = True
Set Paire = Range(Cells(r, sthlh - 1), Cells(r, sthlh))
Exit For
End If
End If
Next sthlh
Loop
If found = False Then
MsgBox " not found"
Else
' found in row
MsgBox "The board u r looking for is in row: " & vbCrLf & vbCrLf & Paire.Address
Paire.Select
End If
End Sub
Bit new to VBA. It seems quite simple though; am not able to figure it out how to use Offset function and While/Do while loop here.
I am making an excel form where columns A to L will have values.
Out of which few columns are mandatory. Those are A, B, C, D, F, G, H, I, J, L.
Which means those can't be left blank and other columns can be blank.
My excel looks like below.
I have written a code where it checks whether mandatory columns have values or not.
The code is as below :
Dim celadr, celval As Variant
Dim cell As Variant
Dim LastRow As Long
LastRow = Range("A65536").End(xlUp).Row
On Error GoTo 0
shname = ActiveSheet.Name
Dim celArray, arr, Key1, KeyCell As Variant
celArray = ("A,B,C,D,F,G,H,I,J,L")
arr = Split(celArray, ",")
For Key1 = LBound(arr) To UBound(arr)
KeyCell = arr(Key1)
Range(KeyCell & "2:" & KeyCell & "" & LastRow).Select
'Selection.Clearformats
For Each cell In Selection
celadr = cell.Address
celval = cell.Value
If celval = "" Then
Range(celadr).Interior.Color = vbRed
strErr = Range(celadr).Value
Sheets("Observations").Range("A65536").End(xlUp).Offset(1, 0).Value = IIf(strErr = "", "Empty Found", strErr)
strstr = "'" & shname & "'!" & Range(celadr).Address(0, 0)
Sheets("Observations").Hyperlinks.Add Anchor:=Sheets("Observations").Range("A65536").End(xlUp), Address:="", SubAddress:= _
strstr, TextToDisplay:=IIf(strErr = "", "Empty Found", strErr)
End If
Next cell
Next Key1
The result of this code is;
1) between each two school records a row may be left blank.
My above code will color such all rows also in red background.
(It should not happen)
2) Columns B, C, D, F, G, H can have values only in the same row in which school_name is mentioned.
So, if following rows for same school are left blank then those also will be colored in red background.
(It should not happen).
So; I want to make small correction to code:
I want to add a condition to code:
"When there is a value in Column A; then only the above code should be exceuted."
I tried to achieve it as I have written in below Code. Still, am not upto.
I have commented all such lines of code which were giving me error (from below code):
Dim celadr, celval, celadr1, celval1 As Variant
Dim cell, cell1 As Variant
Dim LastRow As Long
LastRow = Range("A65536").End(xlUp).Row
On Error GoTo 0
shname = ActiveSheet.Name
Dim celArray, arr, Key1, KeyCell As Variant
'Range("A2:A" & LastRow).Select
'For Each cell1 In Selection
'celadr1 = cell1.Address
'celval1 = cell1.Value
'Do While Len(celval1) >= 1
celArray = ("A,B,C,D,F,G,H,I,J,L")
arr = Split(celArray, ",")
For Key1 = LBound(arr) To UBound(arr)
KeyCell = arr(Key1)
Range(KeyCell & "2:" & KeyCell & "" & LastRow).Select
'Selection.Clearformats
For Each cell In Selection
celadr = cell.Address
celval = cell.Value
' May be another loop over here to increment value in offset function according to column number.
If celval = "" Then 'And Offset Function Referring to column A, same row.
Range(celadr).Interior.Color = vbRed
strErr = Range(celadr).Value
Sheets("Observations").Range("A65536").End(xlUp).Offset(1, 0).Value = IIf(strErr = "", "Empty Found", strErr)
strstr = "'" & shname & "'!" & Range(celadr).Address(0, 0)
Sheets("Observations").Hyperlinks.Add Anchor:=Sheets("Observations").Range("A65536").End(xlUp), Address:="", SubAddress:= _
strstr, TextToDisplay:=IIf(strErr = "", "Empty Found", strErr)
End If
' End If
Next cell
Next Key1
' Loop
Can someone guide me how I can make correct use of offset function/while loops here?
Edit:
Assume, XYZ School don't have value for No. of Teachers
And
PQRS School don't have value for No. of students
My Current output is as in below image:
Where as Expected Output is:
I think the below code should work - try it out and let me know if there are any issues:
Sub Your_Macro()
Dim celArray, item As Variant
Dim LastRow, x As Long
LastRow = Cells(rows.Count, "A").End(xlUp).row
celArray = ("A,B,C,D,F,G,H,I,J,L")
celArray = Split(celArray, ",")
For x = 2 To LastRow
If Not IsEmpty(Cells(x, "A")) Then
For Each item In celArray
If IsEmpty(Cells(x, item)) Then
Cells(x, item).Interior.Color = vbRed
End If
Next item
End If
Next x
End Sub
I have been trying to write a program that will loop through all the cells in an excel sheet and if one starts with a '#' it should display a message. here's the code:
(template is a worksheet variable)
Private Function processTemplate()
Dim total As Long
total = template.UsedRange.count
Dim count As Integer
count = 0
While count <= total
If template.Cells(count).Value Like "[#]*" Then 'Here I get a error
MsgBox "Found #"
End If
count = count + 1
Wend
End Function
I have isolated the error to using a variable inside of cells(). If I replace count with some number (like 8) it works fine. I am getting error 1004 on the line If template.Cells(count).Value Like "[#]*" Then
If I make total an Integer it has the same error at the same place. After about 2-3 hrs of research/banging my head on the wall I have no idea. I initially got the error when assigning template.cells(row, col).Value to a string variable.
Here's my code now:
Private Sub processTemplate()
MsgBox Len("")
Dim str As String
Dim rows As Long
Dim cols As Long
rows = template.UsedRange.Height
cols = template.UsedRange.Width
Dim row As Integer
row = 1
While row < rows
Dim col As Integer
col = 1
While col < cols
str = template.Cells(row, col).Text
If Len(str) > 0 Then
If Left(template.Cells(row, col).Text, 1) = "#" Then
MsgBox "Found IT"
End If
End If
Rem MsgBox template.Parent.Name & ": " & template.Name & ", Cell(" & row & ", " & col & "): " & template.Cells(row, col).Value
col = col + 1
Wend
row = row + 1
Wend
End Sub
Now I get the error on str = template.Cells(row, col).Text
We can use a sub rather than a function
We loop over all the cells in UsedRange looking for a # as the first character in the cell.
Sub FindThePound()
Dim r As Range, pound As String, template As Worksheet
pound = "#"
Set template = ActiveSheet
For Each r In template.UsedRange
If Left(r.Value, 1) = pound Then
MsgBox "Found # in " & r.Address(0, 0)
End If
Next r
End Sub
EDIT#1
This version loops over all the cells, but does not test cells containing formulas
Sub FindThePound()
Dim r As Range, pound As String, template As Worksheet
pound = "#"
Set template = ActiveSheet
For Each r In template.UsedRange
If r.HasFormula = False Then
If Left(r.Value, 1) = pound Then
MsgBox "Found # in " & r.Address(0, 0)
End If
End If
Next r
End Sub
You could use find/ find next function which i guess bit faster than looping through each cell and do string comparison.
With Worksheets(1).Range("a1:a500") 'Provide the search range
Set c = .Find(2, lookin:=xlValues) ' searching for 2 in cell value
If Not c Is Nothing Then
firstAddress = c.Address 'first occurance
Do
'do whatever you want to do with the matches even replace them
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Reference:
http://msdn.microsoft.com/en-us/library/office/ff196143(v=office.15).aspx
I know there are a ton of questions about constructing looped codes in vBA already but hopefully this will be a quick answer, i wasn't able to find a page addressing this issue.
My goal is to check the values from one range with values in another range, and if is a match it will perform a function and display results at the end. However, if the corresponding value in the range is "N/A" I want the results to display immediately and move onto the next checked value. Right now I am obtaining a 'no for loop' error for my code and i understand why. But I don't know how to fix this problem. Can anyone help?
Sub solubility()
Dim coeff As Range, groups As Range
Dim anion As Range
Dim a As Range
Dim nextrow As Long
Dim j As Range
Worksheets("properties").Select
Range("P7:P2000").Select
Selection.ClearContents
'solubility groups range
groups = Worksheets("Solubility").Range("A2:A33")
'group coefficients range
coeff = Worksheets("Solubility").Range("B2:B33")
anion = Worksheets("properties").Range("AB7:AB887")
For Each a In anion
For Each j In groups
If UCase(a.Value) = UCase(groups(j).Value) Then
If groups(j).Value = "" Or "N/A" Then
Worksheets("properties").Range("P" & a.Row).Value = "N/A"
Next a
Else
anvalue = coeff(j).Value * Range("AC" & a.Row).Value
End If
End If
If UCase(Range("AD" & a.Row).Value) = UCase(groups(j).Value) Then
cavalue = coeff(j).Value * Worksheets("properties").Range("AE" & a.Row).Value
If UCase(Range("AF" & a.Row).Value) = UCase(groups(j).Value) Then
cb1value = coeff(j).Value * Worksheets("properties").Range("AG" & a.Row).Value
End If
If UCase(Range("AH" & a.Row).Value) = UCase(groups(j).Value) Then
cb2value = coeff(j).Value * Worksheets("properties").Range("AI" & a.Row).Value
End If
Next j
If UCase(Range("AD" & a.Row).Value) = UCase("[MIm]") Then
cavalue = Range("AE" & a.Row) * Worksheets("solubility").Range("B2").Value + Range("AE" & a.Row) * Worksheets("solubility").Range("B7").Value
End If
nextrow = Worksheets("properties").Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).Row
Worksheets("properties").Range("P" & nextrow).Value = _
anvalue + cavalue + cb1value + cb2value + Worksheets("solubility").Range("b34").Value
Next a
End Sub
I have the line 'Next a' twice, and excel doesnt like this, but I want to automatically jump to the next checked value without performing the remaining function if I get the "N/A" value.
I know this will rile the feathers of some of my purist brethren, but I would actually suggest a judicious use of GoTo in your case:
For Each a In anion
For Each j In groups
If UCase(a.Value) = UCase(groups(j).Value) Then
If groups(j).Value = "" Or "N/A" Then
Worksheets("properties").Range("P" & a.Row).Value = "N/A"
GoTo NextA
....
End If
End If
....
Next j
....
NextA:
Next a
Overuse of GoTo will quickly turn your code into spaghetti, but in this case I think it is actually the most readable option you have.
You must define a reference to an object using SET:
SET groups = Worksheets("Solubility").Range("A2:A33")
(Same for all ranges)