I have data in column A of three sheets. I have to take one sheet's data and have to compare with the remaining two sheets' data.
Can anybody help me?
Without more context/information, I can only give you a high-level response but hopefully it can get you started.
To check if items in one range are found in another range, the code below builds a string from one range then uses "Instr" to compare each item from another range against it. To do more sophisticated comparisons, I'd build arrays from the ranges.
Sub CompareLists()
Dim rng1 As Range, rng2 As Range
Dim cell As Range
Dim tmp As String
Set rng1 = Worksheets("Sheet1").Range("A1:A6")
Set rng2 = Worksheets("Sheet2").Range("A1:A6")
'Build pipe-delimited string from cells in range
For Each cell In rng1
tmp = tmp & cell & "|"
Next cell
'Remove last pipe
tmp = Left(tmp, Len(tmp) - 1)
'Loop list 2 and compare against list 1.
'Specifically, see if each item in list 2 is found in list 1
For Each cell In rng2
If InStr(1, tmp, cell) > 0 Then
'Print items from list 2 that are found in list 1
Debug.Print "Found: " & cell.Value
Else
'Print items from list 2 that are NOT found in list 1
Debug.Print "NOT Found: " & cell.Value
End If
Next cell
Set rng1 = Nothing
Set rng2 = Nothing
Set cell = Nothing
End Sub
Related
I have a table with numbers from 1 to 10. (Starting from D2 to M2)
Suppose in A1 there is 03/09/2019
AND in B1 there is 06/09/2019
AND in C1 there is Hello
In COLUMN A I have a multiple series of words starting from A3 to A10
Here is an Example of the Excel Table
What I would like to do is: Search for the word Student in Column A, when I find it, get the numbers from A1 --> 3
and A2 --> 6 and write the word Hello that is in C1 in the cells that go to 3 to 6 in the row of the finded word Student
So my output would be like:
This is my code so far:
Dim Cell As Range
Columns("A:A").Select
Set Cell = Selection.Find(What:="Student", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Cell Is Nothing Then
MsgBox "Word not found"
Else
MsgBox "Word found"
End If
Basically I can find the word Student but don't know how to write the word Hello in the cells between 3 to 6
A few notes regarding the code below (not tested!).
1) Always try use worksheet qualifiers when working with VBA. This will allow for cleaner code with less room for unnecessary errors
2) When using .Find method I use LookAt:=xlWhole because if you do not explicitly define this your code will use the last known method that you would have used in Excel. Again, explicit definition leaves less room for error.
3) Try include error handling when you code. This provides “break points” for easier debugging in the future.
4) You can make the below much more dynamic that it currently is. But I'll leave that up to you to learn how to do!
Option Explicit
Sub SearchAndBuild()
Dim rSearch As Range
Dim lDayOne As Long, lDayTwo As Long
Dim lColOne As Long, lColTwo As Long
Dim sHello As String
Dim wsS1 As Worksheet
Dim i As Long
'set the worksheet object
Set wsS1 = ThisWorkbook.Sheets("Sheet1")
'store variables
lDayOne = Day(wsS1.Range("A1").Value)
lDayTwo = Day(wsS1.Range("B1").Value)
sHello = wsS1.Range("C1").Value
'find the student first
Set rSearch = wsS1.Range("A:A").Find(What:="Student", LookAt:=xlWhole)
'error handling
If rSearch Is Nothing Then
MsgBox "Error, could not find Student."
Exit Sub
End If
'now loop forwards to find first date and second date - store column naumbers
'adjust these limits where necessary - can make dynamic
For i = 4 To 13
If wsS1.Cells(2, i).Value = lDayOne Then
lColOne = i
End If
If wsS1.Cells(2, i).Value = lDayTwo Then
lColTwo = i
Exit For
End If
Next i
'now merge the range
wsS1.Range(wsS1.Cells(rSearch.Row, lColOne), wsS1.Cells(rSearch.Row, lColTwo)).Merge
'set the vvalue
wsS1.Cells(rSearch.Row, lColOne).Value = sHello
End Sub
This is just one way to approach the problem. Hopefully this helps your understanding!
No need for a loop here - just find your value and parse the dates. Assuming your value to be found exists in Column A and your table starts in Column D, there is clear relationship between the columns which is Day(date) + 3.
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, Found As Range
Dim date_a As Long, date_b As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set Found = ws.Range("A2:A" & lr).Find("Student", LookIn:=xlValues)
If Not Found Is Nothing Then
date_a = Day(Range("A1")) + 3
date_b = Day(Range("B1")) + 3
With ws.Range(ws.Cells(Found.Row, date_a), ws.Cells(Found.Row, date_b))
.Merge
.Value = ws.Range("C1")
End With
Else
MsgBox "Value 'Student' Not Found"
End If
End Sub
I've tried this:
Dim ThisRow As Long
Dim FindWhat As String
FindWhat = "Student"
Dim MyStart As Byte
Dim MyEnd As Byte
MyStart = Day(Range("A1").Value) + 3 'we add +3 because starting 1 is in the fourth column
MyEnd = Day(Range("B1").Value) + 3 'we add +3 because starting 1 is in the fourth column
Dim SearchRange As Range
Set SearchRange = Range("A3:A10") 'range of values
With Application.WorksheetFunction
'we first if the value exists with a count.
If .CountIf(SearchRange, FindWhat) > 0 Then 'it means findwhat exists
ThisRow = .Match(FindWhat, Range("A:A"), 0) 'we find row number of value
Range(Cells(ThisRow, MyStart), Cells(ThisRow, MyEnd)).Value = Range("C1").Value
Application.DisplayAlerts = False
Range(Cells(ThisRow, MyStart), Cells(ThisRow, MyEnd)).Merge
Application.DisplayAlerts = True
Else
MsgBox "Value 'Student' Not Found"
End If
End With
Note I've used worksheets function COUNTIF and MATCH. MATCH will find the position of an element in a range, so if you check the whole column, it will tell you the row number. But if it finds nothing, it will rise an error. Easy way to avoid that is, first, counting if the value exists in that range with COUNTIF, and if it does, then you can use MATCH safely
Also, note that because we are using MATCH, this function only finds first coincidence, so if your list of values in column A got duplicates, this method won't work for you!.
Here is a sample of the report I have:
Basically the report consists in a huge list of suppliers where among other things, I need to identify which of them have all entities (content groups) for the same country, while ignoring the "integrate" tag. Entities for each country are defined in a table separately (right).
So far I tried a combination of =SUMPRODUCT(--(ISNUMBER(SEARCH())) but always getting partially what I want.
In column C, in need:
to display YES if the supplier on that row has all entities for the mentioned country code;
to display NO otherwise;
My logic on this:
The formula/s needs to pick the country code from 1st table, then look into the 2nd table where entities are defined and check if all the entities in the content group are matching, ignoring "integrate" which is a default tag applied everywhere.
Expected result:
Try:
Option Explicit
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRowA As Long, i As Long, y As Long
Dim arr As Variant
Dim CountryCode As String
Dim rng As Range, SearchRange As Range, FindPosition As Range
Dim Appears As Boolean
'Set worksheets on variables
With ThisWorkbook
Set ws1 = .Worksheets("Sheet1")
Set ws2 = .Worksheets("Sheet2")
End With
'Set the range to search in for country codes
Set SearchRange = ws2.Range("H1:R1")
With ws1
'Find the last row of Column A sheet1
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
'Start loop from row 2 to last row sheet1
For i = 2 To LastRowA
'Criteria needed ( Column A - Not empty cell, Column D - Includes "Europe" & Column E - Includes "No" Columns D and E are CASE SENSITIVE)
If .Range("A" & i).Value <> "" And .Range("D" & i).Value = "Europe" And .Range("E" & i).Value = "No" Then
CountryCode = .Range("B" & i).Value
'In which column the country code found
Set FindPosition = SearchRange.Find(What:=CountryCode, LookIn:=xlValues, LookAt:=xlWhole)
'If code excist
If Not FindPosition Is Nothing Then
'Set the range to search for the groups in the column where the code is header
Set rng = ws2.Range(ws2.Cells(2, FindPosition.Column), ws2.Cells(ws2.Cells(ws2.Rows.Count, FindPosition.Column).End(xlUp).Row, FindPosition.Column))
'Split the string with comma and assing it on arr
arr = Split(.Range("A" & i).Value)
Appears = False
'Loop the arr
For y = LBound(arr) To UBound(arr)
'Check if the arr(y) start from C as all code start from C
If Left(arr(y), 1) = "C" Then
'Count how many times the arr(y) with out the comma appears in the rng
If Application.WorksheetFunction.CountIf(rng, Replace(arr(y), ",", "")) > 0 Then
'If appears the variable Appears is true
Appears = True
Else
'If does not appear the variable Appears is False & Exit the loop
Appears = False
Exit For
End If
End If
Next y
'Check Appears variable status and import value in Column C
If Appears = True Then
.Range("C" & i).Value = "Yes"
Else
.Range("C" & i).Value = "No"
End If
'If code does not excist
Else: MsgBox "Country Code not does not excist."
End If
End If
Next i
End With
End Sub
If you have a version of Excel 2013+ which has the FILTERXML function, you can use this array formula:
=IF(OR(ISNA(MATCH(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A2,"Integrate",""),", ",","),",","</s><s>")&"</s></t>","//s"),INDIRECT("Table2["&B2&"]"),0))),"No","Yes")
We remove the Integrate
Create an XMLfrom the strings in Table1
Extract each element of the XML
Try to find them in the appropriate column of Table2
If we don't find one, then it has multiple countries.
Since this is an array formula, you need to "confirm" it by holding down ctrl + shift while hitting enter. If you do this correctly, Excel will place braces {...} around the formula as observed in the formula bar
If you have a version of Excel that does not have this function, and you are still interested in using excel formulas as opposed to VBA, there is another formula we can use.
Hello all this is my first question so I will try my best to format this best I can.
Quick description without specific cell names below
I am trying to write a macro where a user enters a value(X) and a macro searches a range of cells for a value(X), and then the macro returns the cell values in the 3 spaces next to wherever the location of value(X) is.
A couple things that are making this impossible to solve are the fact that the user inputs the value on Sheet1 and the value is moved to Sheet2 by a formula, I can't seem to figure out how to use Find where the values I am searching for isn't already defined in the macro.
The other thing making this difficult is that the range is not strictly definable either, as the list could be longer or shorter than it currently is, and I can't know when it will change. So the range of the search has to start based on which List is input by the User and needs to go until it hits a blank spot.
For example: Range.("C7:D10") wont work because the user could enter new info that changes the working range as described below.
Below is a screenshot with further explanation
https://i.stack.imgur.com/wlnhg.jpg
So in this screenshot the cells C3 and D3 are imported values from Sheet1.
C3 is (=Sheet1!B2)
D3 is (=Sheet1!B3)
The idea is that the macro runs and searches down column A till it has a match with C3.
Then the search function moves over two cells and searches down till it has a match with D3 or until it hits an empty space.
I don't know how to ask a macro to search based on an imported value, and I don't know how to ask it to search this weird certain range I need. The idea is that someone at my work could come along and add a row below C10 and add the necessary information and the macro would still work and search to C11 and there would be a blank space after to tell the macro to stop.
After the search finds a match for D3 it would return the values adjacent to the match to the corresponding cells at the top, E3, F3, and G3.
I hope this question is asked in a way that people can understand, I am very tired so can't tell if I wrote something that makes sense. Thank you for reading my post, y'all are the best!!
Search Twice
Workbook Download (Dropbox)
Sub SearchTwice()
Const cSheet As String = "Sheet2" ' Source Worksheet Name
Const cList As String = "C3" ' List Cell Range Address
Const cName As String = "D3" ' Name Cell Range Address
Const cListCol As String = "A" ' List Column Letter
Const cNameCol As String = "C" ' Name Column Letter
Const cFirst As Long = 6 ' First Row
Const cCol As Long = 3 ' Number of Columns
Dim rng1 As Range ' Find List Cell Range
' Found Name Cell Range
Dim rng2 As Range ' Next List Cell Range
' Name Search Range
Dim strList As String ' List
Dim strName As String ' Name
' In Source Worksheet
With ThisWorkbook.Worksheets(cSheet)
' Write from List Cell Range to List.
strList = .Range(cList)
' Write from Name Cell Range to Name.
strName = .Range(cName)
' Check if Cell Ranges do NOT contain data.
If strList = "" Or strName = "" Then ' Inform user.
MsgBox "Missing List or Name.", vbCritical, "Missing data"
Exit Sub
End If
' In List Column
With .Columns(cListCol)
' Create a reference to Find List Cell Range (rng1) containing
' List (strList).
Set rng1 = .Find(strList, .Cells(cFirst - 1), xlValues, xlWhole)
' Check if List has not been found.
If rng1 Is Nothing Then ' Inform user and exit.
MsgBox "The list '" & strList & "' has not been found", _
vbCritical, "List not found"
Exit Sub
End If
' Create a reference to Next List Cell Range (rng2).
Set rng2 = .Find("*", .Cells(rng1.Row), xlValues, xlWhole)
End With
' In Name Column
With .Columns(cNameCol)
' Check if the row of Next List Cell Range (rng2) is greater than
' the row of List Cell Range (rng1) i.e. if a cell with a value
' has been found below List Cell Range (rng1) in List Column.
If rng2.Row > rng1.Row Then ' Next List Cell Range FOUND.
' Create a reference to Name Search Range (rng2) which spans
' from the cell below Find List Cell Range (rng1) to the cell
' above the Next List Cell Range (rng2), but in Name Column.
Set rng2 = .Cells(rng1.Row + 1).Resize(rng2.Row - rng1.Row - 1)
Else ' Next List Cell Range NOT found.
' Create a reference to Name Search Range (rng2) which spans
' from the cell below Find List Cell Range (rng1) to the bottom
' cell, but in Name column.
Set rng2 = .Cells(rng1.Row + 1).Resize(.Rows.Count - rng1.Row)
End If
End With
' In Name Search Range (rng2)
With rng2
' Create a reference to Found Name Cell Range (rng1).
Set rng1 = .Find(strName, .Cells(.Rows.Count), xlValues, xlWhole)
End With
' Check if Name has not been found.
If rng1 Is Nothing Then ' Inform user and exit.
MsgBox "The name '" & strName & "' has not been found", _
vbCritical, "Name not found"
Exit Sub
End If
' Remarks:
' Source Range is calculated by moving the Found Name Cell Range (rng1)
' one cell to the right and by resizing it by Number of Columns (cCol).
' Target Range is calculated by moving the Name Cell Range one cell
' to the right and by resizing it by Number of Columns (cCol).
' Copy values of Source Range to Target Range.
.Range(cName).Offset(, 1).Resize(, cCol) _
= rng1.Offset(, 1).Resize(, cCol).Value
End With
' Inform user of succes of the operation.
MsgBox "The name '" & strName & "' was successfully found in list '" & _
strList & "'. The corresponding data has been written to the " _
& "worksheet.", vbInformation, "Success"
End Sub
One reason for being tired is that you tried to go for the kill before you had set up for slaughter. The solution below took an hour to prepare and 10 minutes to encode. Paste the entire code in a standard code module and call the function MatchRow either from the Immediate window (? MatchRow) or from your own code as shown in the test proc further down.
Option Explicit
Enum Nws ' worksheet navigation
' 01 Mar 2019
NwsCriteriaRow = 3
NwsList = 1 ' Columns: (1 = A)
NwsID = 3
NwsNumber ' (undefined: assigns next integer)
End Enum
Function MatchRow() As Long
' 01 Mar 2019
' return 0 if not found
Dim Ws As Worksheet
Dim Rng As Range
Dim R As Long
' The ActiveWorkbook isn't necessarily ThisWorkbook
Set Ws = ActiveWorkbook.Worksheets("Sheet2") ' replace tab's name here
With Ws
Set Rng = .Range(.Cells(NwsCriteriaRow, NwsList), .Cells(.Rows.Count, NwsList).End(xlUp))
R = FindRow(.Cells(NwsCriteriaRow, NwsID).Value, Rng, True)
If R Then ' skip if no match was found
Set Rng = .Cells(R + 1, NwsID)
Set Rng = .Range(Rng, Rng.End(xlDown))
MatchRow = FindRow(.Cells(NwsCriteriaRow, NwsNumber).Value, Rng)
End If
End With
End Function
Private Function FindRow(Crit As Variant, _
Rng As Range, _
Optional ByVal SearchFromTop As Boolean) As Long
' 01 Mar 2019
' return 0 if not found
Dim Fun As Range
Dim StartCell As Long
With Rng
If SearchFromTop Then
StartCell = 1
Else
StartCell = .Cells.Count
End If
Set Fun = .Find(What:=Crit, _
After:=.Cells(StartCell), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)
End With
If Not Fun Is Nothing Then FindRow = Fun.Row
End Function
The function MatchRow returns the row number of Sheet2 where D3 is found, searching only that part of column D which belongs to the list identified in C3. The function returns 0 if no match was found, either of the list or the ID.
You didn't specify what you want to do with the found row. The procedure below will return data from that row. You might use the capability to address the cells to write to them instead.
Private Sub RetrieveData()
Dim R As Long
R = MatchRow
MsgBox "ID = " & Cells(R, NwsID).Value & vbCr & _
"Number = " & Cells(R, NwsNumber).Value
End Sub
Being intended for testing only the above proc doesn't specify the worksheet and, therefore, returns data from the ActiveSheet, presumed to be Sheet2.
VBA Solution
I think the non-VBA solution is ideal here, but I will leave this here separately just in case. This should work for your situation assuming no values in your tables are blank.
Sub Test()
Dim ws As Worksheet: Set Worksheet = ThisWorkbook.Sheets("Sheet2")
Dim iList As Range, iName As Range
Dim aLR As Long, cLR As Long
aLR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set iList = ws.Range("A1:A" & aLR).Find(ws.Range("C3"), LookIn:=xlWhole)
If Not iList Is Nothing Then
cLR = iList.Offset(0, 2).End(xlDown).Row
Set iName = ws.Range(ws.Cells(iList.Row, 3), ws.Cells(cLR, 3)).Find(ws.Range("C4"), LookIn:=xlWhole)
If Not iName Is Nothing Then
ws.Range("E3:G3").Value = iName.Offset(0, 1).Resize(1, 3).Value
End If
End If
End Sub
Non VBA Solution
Convert your two list ranges to tables
Change the name of your tables by (Formulas Tab > Name Manager > Select Table/Change Name). Specifically, you will want to change the names to your desired list name. (Table 1 Name = List1 & Table 2 Name = List2)
Next, drop these formulas inside E3, F3, & G3
E3 = VLOOKUP(D3, Indirect(C3), 2, 0)
F3 = VLOOKUP(D3, Indirect(C3), 3, 0)
G3 = VLOOKUP(D3, Indirect(C3), 4, 0)
This wil update dynamically as your table sizes expand. you can also add as many tables as you'd like and this will continue to work.
In use, it looks something like below
My last suggestion would be to nest each formula above inside an IFERROR()
I have a worksheet that contains a varying amount of Rows of data in Column A , within this worksheet I need to search for a specific string then copy the data contained in the Cell adjacent to it and paste into Column C, i.e if data was found in A2 then i need to copy the data from B2 and paste into C1. I can easily find and copy when the string appears once but the string will appear more than once 100% of time. here is when i run into issues.
The temporary code I have written for ease of understanding, searches the spreadsheet for the last Mention of A, get the row number, copy the B cell for that row number then pastes the value into C1.
I guess you need to use range variables for this but not 100% sure how to do it.
i have found no way to copy all mentions of A into a column, or ideally sum up the contents of the B cells. (I can do this, just long winded)
Ive placed my code below.
Sub ValueFinder()
Dim LastALocation As String
Dim ValueContent As String
LastALocation = Range("A:A").Find(What:="A", after:=Range("A1"), searchdirection:=xlPrevious).Row
ValueContent = Cells(LastALocation, 2)
Cells(1, 3) = ValueContent
End Sub
The spreadsheet that its using for more information, contains A,B,C on a loop in Column A and the odd numbers in Column B.
Thanks for any help your able to provide.
Mark
This will look for a string in Column A, and add to Column C the same row's B Column Value.
Sub find_move()
Dim foundCel As Range
Dim findStr As String, firstAddress As String
Dim i As Long
i = 1
findStr = "A"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("C" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
End Sub
Note: You should add the worksheet in front of all the range values, i.e. Sheets("Sheet1").Range("A:A").Find(...
Consider:
Sub LookingForA()
Dim s As String, rng As Range, WhichRows() As Long
Dim rFound As Range
ReDim WhichRows(1)
s = "A"
Set rng = Range("A:A")
Set rFound = rng.Find(What:=s, After:=rng(1))
WhichRows(1) = rFound.Row
Cells(1, 3) = Cells(rFound.Row, 2)
Do
Set rFound = rng.FindNext(After:=rFound)
If rFound.Row = WhichRows(1) Then Exit Do
ReDim Preserve WhichRows(UBound(WhichRows) + 1)
WhichRows(UBound(WhichRows)) = rFound.Row
Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, 3) = Cells(rFound.Row, 2)
Loop
End Sub
This code builds column C. It also builds an internal array of the row numbers in the event they are needed later.
EDIT#1:
To read about dynamic arrays:
Dynamic Arrays
or Google:
Excel VBA dynamic array
Sub selecting()
Dim r as Range
Set r = Application.Selection
MsgBox r.Cells(1,1).Address(false,false)
MsgBox r.Cells(1,2).Address(false,false)
MsgBox r.Cells(2,1).Address(false,false)
End Sub
Now the thing is, I select some random cells as irregular range in excel sheet. I get first cell address correct but the next cell address is the cell neighbor to the first one, and not the next cell that I selected.
Basically, I want to collect values from irregular ranges into an array. It would be really helpful if I get addresses of each cell selected in this irregular range.
Simply saying, what I want is if I select cells e1,g4,d7,r1,t3 I should get an array of only these 5 cells in vba program, and this array should have no access to other cells apart from those that were selected.
I am a little unclear on exactly what you are attempting, but I believe this may help you understand the behavior of the script as it's running.
Sub selecting()
Dim myArray(0 To 100, 0 To 1) As Variant
Dim rngSelected As Range
Set rngSelected = Application.Selection
Dim rng As Range
For Each rng In rngSelected
Dim counter As Integer
Debug.Print "The value of cell " & counter & " is " & rng.Value & _
" , and the address is " & rng.Address(False, False)
myArray(counter, 0) = rng.Value
myArray(counter, 1) = rng.Address(False, False)
counter = counter + 1
Next rng
End Sub
Maybe you can tweak this until you get the behavior you are looking for?