I have a excel file which looks like below:
Now, I've created a list in cell "L2" using the values in the name column and added a button "Find".
What I'm trying to do is when I click the button after selecting a value in "L2", it will give me the respective values of Name, ID, DOB, Email from the table "A4:E12" in the cells "I6:L6" and if "I6:L6" has values then it will move to "I7:L7" and so on every time I hit the button.
Here is the code I've done:
Sub getValues()
Range("I6").Select
ActiveCell.Formula = "=VLOOKUP($L$2,$A$5:$E$12,{1,2,4,5},0)"
Range("I6").AutoFill Destination:=Range("I6:L6"), Type:=xlFillDefault
Range("I6:L6").Select
Range("A3").Select
End Sub
The problem with this code is it is giving the values like below:
Where expected result is:
Also, it should automatically paste the values to "I7:L7" if "I6:L6" is occupied and so on.
Can anyone show me how can I do that?
This is a long answer (and not the most efficient) but I wrote it this way to illustrate it step by step
See comments inside the code and adapt it to fit your needs
Public Sub GetDataByPersonName()
Dim sourceSheet As Worksheet
Dim sourceDataRange As Range
Dim rowOffset As Long
Dim sourceSheetName As String
Dim sourcePersonName As String
Dim sourceRangeAddress As String
Dim sourceLookupTableRange As String
Dim sourceMatchedRow As Variant
' Results
Dim resultsInitialCellAddress As String
Dim resultName As Variant
Dim resultID As Variant
Dim resultCountry As Variant
Dim resultDOB As Variant
Dim resultEmail As Variant
' Adjust to your needs
sourceSheetName = "Sheet1" ' Sheet name where data is located
sourceRangeAddress = "L2" ' Cell address of enter name
sourceLookupTableRange = "A4:E12" ' Range address where lookup data is located
resultsInitialCellAddress = "I4" ' Cell address of headers destination where results are going to be added
' Set references to sheet and lookup range
Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName)
Set sourceDataRange = sourceSheet.Range(sourceLookupTableRange)
' Get the current name to be looked up
sourcePersonName = sourceSheet.Range(sourceRangeAddress).Value
' Lookup the results (see columns(1) to check the column where name is located
sourceMatchedRow = Application.Match(sourcePersonName, sourceDataRange.Columns(1), 0)
If Not IsError(sourceMatchedRow) Then
' Find the last empty row below results header
If sourceSheet.Range(resultsInitialCellAddress).Offset(1, 0).Value = vbNullString Then
rowOffset = 1
Else
rowOffset = sourceSheet.Range(resultsInitialCellAddress).End(xlDown).Row - sourceSheet.Range(resultsInitialCellAddress).Row + 1
End If
' Name (see name column is 1 at the end for line)
resultName = Application.WorksheetFunction.Index(sourceDataRange, sourceMatchedRow, 1)
resultID = Application.WorksheetFunction.Index(sourceDataRange, sourceMatchedRow, 2)
resultCountry = Application.WorksheetFunction.Index(sourceDataRange, sourceMatchedRow, 3)
resultDOB = Application.WorksheetFunction.Index(sourceDataRange, sourceMatchedRow, 4)
resultEmail = Application.WorksheetFunction.Index(sourceDataRange, sourceMatchedRow, 5)
' Dump results into worksheet
sourceSheet.Range(resultsInitialCellAddress).Offset(rowOffset, 0).Value = resultName
sourceSheet.Range(resultsInitialCellAddress).Offset(rowOffset, 1).Value = resultID
sourceSheet.Range(resultsInitialCellAddress).Offset(rowOffset, 2).Value = resultCountry
sourceSheet.Range(resultsInitialCellAddress).Offset(rowOffset, 3).Value = resultDOB
sourceSheet.Range(resultsInitialCellAddress).Offset(rowOffset, 4).Value = resultEmail
End If
End Sub
Remeber to mark the answer if it helped you, to help others
Ok, I think you should try to do this yourself, and record your steps in a Macro. You will learn a ton that way. See the link below.
https://www.get-digital-help.com/how-to-return-multiple-values-using-vlookup-in-excel/
Turn on the Macro recorder before you click though the steps. Then, you will have all the code you need!!
Related
I'm novice in VBA. I'm trying to transpose my data:
I would like to have this results:
I tried all day the methodes like: Resize(UBound(Table2, 1), UBound(Table2, 2)) = Table2, Application.transpose(Tbl1) but I don't have the diserid result. Could you help me please? Thank you very much!
A Power Query Solution (CVR)
Added corrections; credits to Ron Rosenfeld.
Click into your table.
Select Data > From Table/Range: The Power Query Editor opens containing your data.
The first columns is selected. If not, click the header of your first column (Date) to select it.
Select Transform > Pivot Column: The Pivot Column window opens.
In the Values Column combo box the second column (Values) is already selected. If not, select it.
Click Advanced Options where Sum is already selected which will sum multiple entries for the same ID/Date columns. If not, select it.
Press OK. The data is transformed.
Select Home > Close & Load: The Power Query Editor closes and the transformed data is presented in a table in a new worksheet.
Short Version
Click into your table.
Select Data > From Table/Range: The Power Query Editor opens containing your data.
Select Transform > Pivot Column: The Pivot Column window opens.
Press OK. The data is transformed.
Select Home > Close & Load: The Power Query Editor closes and the transformed data is presented in a table in a new worksheet.
With Office365 you can use below formulas (as per my screenshot).
F2=UNIQUE(C1:C11)
G1=TRANSPOSE(SORT(UNIQUE(A1:A10)))
G2=FILTER($B$1:$B$11,($C$1:$C$11=$F2)*($A$1:$A$11=G$1),"")
After putting FILTER() formula to G2 cell drag across right and down as needed.
You can also use XLOOKUP() instead of FILTER() formula to G2 like-
=XLOOKUP(1,($A$1:$A$11=G$1)*($C$1:$C$11=$F2),$B$1:$B$11,"")
Pivot CVR
CVR: Column Labels, Values, Row Labels.
It is assumed that the initial data, the Source Range, contains a row of headers, whose third cell value will be copied to the first cell of the resulting data, the Destination Range.
Adjust the values in the constants section.
Copy the complete code to a standard module, e.g. Module1.
Only run the first procedure, pivotDataCVR, the other two are being called by it, when necessary.
A similar solution, which I based this solution on, although RCV, can be found here.
The Code
Option Explicit
Sub pivotDataCVR()
' Define constants.
Const srcName As String = "Sheet1"
Const srcFirst As String = "A1"
Const dstName As String = "Sheet2"
Const dstFirst As String = "A1"
' Define workbook.
Dim wb As Workbook
Set wb = ThisWorkbook
' Define Source First Cell Range.
Dim cel As Range
Set cel = wb.Worksheets(srcName).Range(srcFirst)
' Define Source Range.
Dim rng As Range
With cel.CurrentRegion
Set rng = cel.Resize(.Rows.Count + .Row - cel.Row, _
.Columns.Count + .Column - cel.Column)
End With
' Get unique values.
Dim dts As Variant
dts = getUniqueColumn1D(rng.Columns(1).Resize(rng.Rows.Count - 1).Offset(1))
sort1D dts
Dim idx As Variant
idx = getUniqueColumn1D(rng.Columns(3).Resize(rng.Rows.Count - 1).Offset(1))
sort1D idx
' Write values from Source Range to Source Array.
Dim Source As Variant
Source = rng.Value
' Define Destination Array.
Dim Dest As Variant
ReDim Dest(1 To UBound(idx) - LBound(idx) + 2, _
1 To UBound(dts) - LBound(dts) + 2)
' Write values from arrays to Destination Array.
Dest(1, 1) = Source(1, 3)
Dim n As Long
Dim i As Long
i = 1
For n = LBound(idx) To UBound(idx)
i = i + 1
Dest(i, 1) = idx(n)
Next n
Dim j As Long
j = 1
For n = LBound(dts) To UBound(dts)
j = j + 1
Dest(1, j) = dts(n)
Next n
For n = 2 To UBound(Source, 1)
i = Application.Match(Source(n, 3), idx, 0) + 1
j = Application.Match(Source(n, 1), dts, 0) + 1
Dest(i, j) = Source(n, 2)
Next n
' Define Destination First Cell Range.
Set cel = wb.Worksheets(dstName).Range(dstFirst)
' Define Destination Range.
Set rng = cel.Resize(UBound(Dest, 1), UBound(Dest, 2))
' Write from Destination Array to Destination Range.
rng.Value = Dest
' Inform user.
MsgBox "Data transferred.", vbInformation, "Success"
End Sub
' Returns the unique values from a column range in a 1D array.
Function getUniqueColumn1D(ColumnRange As Range, _
Optional ByVal Sorted As Boolean = False) _
As Variant
Dim Data As Variant
Data = ColumnRange.Columns(1).Value
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
Dim Key As Variant
Dim i As Long
For i = 1 To UBound(Data, 1)
Key = Data(i, 1)
If Not IsError(Key) And Not IsEmpty(Key) Then
.Item(Key) = Empty
End If
Next i
If .Count > 0 Then
getUniqueColumn1D = .Keys
End If
End With
End Function
' Sorts a 1D array only if it contains values of the same data type.
Sub sort1D(ByRef OneD As Variant, _
Optional ByVal Descending As Boolean = False)
With CreateObject("System.Collections.ArrayList")
Dim i As Long
For i = LBound(OneD) To UBound(OneD)
.Add OneD(i)
Next i
.Sort
If Descending Then
.Reverse
End If
OneD = .ToArray
End With
End Sub
So i have an excel file where i can enter the different projects that i want to analyse and the location of the files. Then a code to go and get the files and generate 2 sheets (from a template that i created) for each project entered and populate the data. These projects can vary the name and quantity.
My problem appears when i try to do a total table. Where i would go and get from the same cell in the different sheets the value and sum them. The number of sheets can change so i didnt manage to use a sheets.count, but the name of the sheets that relevant for this operation all start by "Total_".
So the beginning of the code that i have so far is:
`Sub refresh()
Parametre
Dim nbOnglet As Integer
Dim nbProjet As Integer
Dim name As String
Dim nametot As String
Dim A As String
Dim B As String
Dim idx As Integer
Dim iDebut As Integer
Dim values As Variant
Dim rng As Range
Dim xRng As Range
Dim x As Long
Dim vArray As Variant
Dim dSum As Double
Initialisation
iDebut = 9
Déterminer le nombre d'onglets du Classeur
nbOnglet = Sheets.Count
Déterminer le nombre de projet à traiter
folderpath = Range("C3").Value
Sheets("Sommaire").Select
nbLigne = Cells(10, "A").Value
x = 0
For idx = 1 To nbLigne
activate Récapitulatif
Sheets("Récapitulatif").Select
Define the variable name - tab name
A = "Total_"
B = Sheets("Sommaire").Cells(iDebut + idx, "D").Value
name = B
nametot = A & B`
Then for the sun i have tried different options but none appears to work for the entire table. I managed to get the good result for one cell by using the following:
x = x + sheets(nametot).range("F7").Value2
But couldn't do it for all the range (F7:CI31).
Other formula that i have tried was:
Set xRng = ThisWorkbook.Sheets(nbLigne).Range("K7:CI31")
xRng.FormulaR1C1 = "=SUM('" & ThisWorkbook.Sheets(nametot).name & "'!RC+'" & ThisWorkbook.Sheets(nametot).name & "'!RC)"
Although this gives the equation that i want since it is running in a loop, it calculates the same for each sheet and stops at the last one identified... So not doing what i would like to: sum the same cell across the different sheets named 'Total_XXXX' and present the value in the 'Récapitulatif' sheet.
I have been looking around internet and i can't really figure out a way to do it.
DO you have any ideas?
Thank you so much in advance
example of the table
Consolidate Worksheets
Links (Microsoft Docs)
Range.Address
Range.Consolidate
XlConsolidationFunction Enumeration
Description
In the workbook containing this code (ThisWorkbook), the following will consolidate (in this case sum up (xlSum)) all the same ranges (srcRange) in all worksheets with names starting with a specified string (srcLead) into another worksheet (tgtName) starting from a specified cell (tgtFirst).
The Code
Option Explicit
Sub consolidateWorksheets()
' Define constants.
Const srcRange As String = "K7:CI31"
Const srcLead As String = "Total_"
Const tgtName As String = "Récapitulatif"
Const tgtFirst As String = "A1"
' Define workbook.
Dim wb As Workbook
Set wb = ThisWorkbook
' Define Target Worksheet.
Dim tgt As Worksheet
Set tgt = wb.Worksheets(tgtName)
' Define R1C1-Style Source Ranges Address.
Dim rcRng As String
rcRng = tgt.Range(srcRange).Address(ReferenceStyle:=xlR1C1)
' Define Consolidation Array.
Dim Data As Variant
ReDim Data(1 To wb.Worksheets.Count)
' Declare variables.
Dim ws As Worksheet ' Current Source Worksheet
Dim CurrentName As String ' Current Source Worksheet Name
Dim n As Long ' Current Element in Consolidation Array
' Write full paths of Source Worksheets to Consolidation Array.
For Each ws In wb.Worksheets
CurrentName = ws.Name
If InStr(1, CurrentName, srcLead, vbTextCompare) = 1 Then
n = n + 1
Data(n) = "'" & ws.Name & "'!" & rcRng
End If
Next ws
' Validate and resize Consolidation Array.
If n = 0 Then
MsgBox "No worksheets to consolidate.", vbCritical, "Fail"
Exit Sub
End If
ReDim Preserve Data(1 To n)
' Consolidate.
tgt.Range(tgtFirst).Consolidate Sources:=Data, _
Function:=xlSum
' Inform user.
MsgBox "Data consolidated.", vbInformation, "Success"
End Sub
New to VBA coding and 1st time that I'm asking something, so give some slack if you see some dummy code.
I have an Excel Table which in column A has dates in the mm/dd/year format. I want to change it to dd/mm/year and in order to make some practice in VBA, I tried to do it via code (i have tried the Format Cells options but didn't work).
For a start I'm trying to rewrite the Date column in column H with the desired format using the following code:
Public Sub ChangingDateFormat()
Dim dest As Range
Dim dindx As Integer
Dim cll As Range
Dim x As String
Dim y As String
Dim z As String
'Establish where output goes
Set dest = Range("H2")
'Set counter for output rows
dindx = 0
'Establish your North Star reference
Set cll = Range("A2")
'Loop as long as anchor cell down isn't blanc
While cll.Offset(dindx, 0) <> ""
'Test if not empty; if not empty populate destination with data
If cll.Offset(dindx, 0) <> "" Then
x = Left(cll.Offset(dindx, 0), 2)
y = Mid(cll.Offset(dindx, 0), 4, 3)
z = Right(cll.Offset(dindx, 0), 5)
'True case: Output date
dest.Offset(dindx, 0) = y & x & z
'Increment row counter
dindx = dindx + 1
End If
'End While statement
Wend
End Sub
However, when the macro runs, some cells have the desired format and others not.
The Excel sheet looks like this:
My WorkSheet
Any ideas where the problem is? Pointing me to a direction would be deeply appreciated.
Thanks
Try using Format function like that (This is just sample) and try to implement in your code
Sub Test()
Dim r As Range
Set r = Range("A1")
r.Offset(, 3).Value = Format(r.Value, "dd/mm/yyyy")
End Sub
Excel Table (ListObject)
The following covers only the part I have an Excel Table which in column A has dates in the mm/dd/year format. I want to change it to dd/mm/year... i.e. the values in column A are real dates, not text.
Adjust the sheet and table names appropriately.
Since you are dealing with a ListObject (Table), you might consider using its properties.
The following procedures show how you can exploit some of them in two cases.
The first procedure will change the number format in the first column of the table, (not necessarily the first column of the worksheet). It is used when a column is always the first, so the header (title) can be changed.
The second procedure will try to find the given header (Header). If successful, it will apply the number formatting to the column where the header was found. It is used when the header (title) will never change, but the position of the column in the table might.
The Code
Sub IOnlyKnowTheColumnNumber()
' The n-th column of the Table, not the worksheet.
Const DateColumn As Long = 1
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1")
Dim tbl As ListObject
Set tbl = ws.ListObjects("Table1")
' Define Date Column Range ('rng').
Dim rng As Range
Set rng = tbl.DataBodyRange.Columns(DateColumn)
' Apply formatting to Date Column Range.
rng.NumberFormat = "dd/mm/yyyy" ' "dd\/mm\/yyyy" for international.
' Inform user.
MsgBox "Number format applied.", vbInformation, "Success"
End Sub
Sub IOnlyKnowTheColumnTitle()
Const Header As String = "Date"
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1")
Dim tbl As ListObject
Set tbl = ws.ListObjects("Table1")
' Define Header Row Range (Headers, Titles).
Dim hRng As Range
Set hRng = tbl.HeaderRowRange
' Try to calculate the Date Column Number.
Dim Temp As Variant
Temp = Application.Match(Header, hRng, 0)
If Not IsError(DateColumn) Then
' Define Date Column.
Dim DateColumn As Long
DateColumn = CLng(Temp)
' Define Date Column Range ('rng').
Dim rng As Range
Set rng = tbl.DataBodyRange.Columns(DateColumn)
' Apply formatting to Data Column Range.
rng.NumberFormat = "dd/mm/yyyy" ' "dd\/mm\/yyyy" for international.
' Inform user.
MsgBox "Number format applied.", vbInformation, "Success"
Else
' inform user.
MsgBox "Could not find '" & Header & "' column.", vbExclamation, "Fail"
End If
End Sub
Dear stack overflow community:
To be brief, the goal of this program is to allow user to input text in Cell C53 and for the program to find matching text in a string in contained in each row within Column A, then return the text in column B on the same row if found (otherwise, return "Use your best judgement".)
I've successfully created the VBA code to find a matching text in a specific row in Column A and return the value in the same row in column B. However, it only works on one row hardcoded into the code. I need to adjust it to loop through a range of rows in column A because there may be matching text in other rows.
My code currently looks like this:
Sub Test_2()
Dim SearchString, SearchText
SearchKey = Range("A1")
SearchNote = Range("C53")
If InStr(SearchNote, SearchKey) > 0 Then
Range("C59").Value = Range("B1").Value
Else
Range("C59").Value = "Please use your best judgement."
End If
End Sub
Hence, if A1 contains "limit", and I type into C53 "client wants to upgrade limit", it will return to C59 the text in B1 because it was found.
The only addition I have been trying to make is nesting what I currently have into a loop to check other rows in Column A. For example, if A1 was "cheque" and A2 was "limit", my current code would only check A1 and not find a match resulting in the prompt "Please use your best judgement." It should be able to check A1, A2, A3 ... A50 ...
I've been having difficulties translating this to code in VBA, and was hoping for some assistance.
Find Word in Sentence
The 1st code goes into a standard module e.g. Module1. Only run the 1st procedure which is calling the 2nd procedure when needed.
Adjust the constants as you see fit. If this is used in one worksheet only then you have to change srcName and tgtName to the same string.
To automate this, copy the second short code to the sheet module (e.g. Sheet1) worksheet where the Answer and Question Cells are. Then you run nothing, it's automatic.
Standard Module e.g. Module1
Option Explicit
Public Const queCell As String = "C53" ' Question Cell
Sub writeAnswer()
' Data
Const srcName As String = "Sheet1" ' Source Worksheet Name
Const srcFirstRow As Long = 1 ' Source First Row Number
Const srcLastRowCol As String = "A" ' Source Last Row Column ID
Dim Cols As Variant: Cols = Array("A", "B") ' Source Column IDs
' Target
Const tgtName As String = "Sheet1" ' Target Worksheet Name
Const ansCell As String = "C59" ' Answer Cell
' Other
Const msg As String = "Please use your best judgement." ' Not Found Message
Dim wb As Workbook: Set wb = ThisWorkbook ' The workbook with this code.
' Define column range.
Dim src As Worksheet: Set src = wb.Worksheets(srcName)
Dim rng As Range
Set rng = src.Columns(srcLastRowCol).Find("*", , xlValues, , , xlPrevious)
If rng Is Nothing Then Exit Sub
If rng.Row < srcFirstRow Then Exit Sub
Set rng = src.Range(src.Cells(srcFirstRow, srcLastRowCol), rng)
' Write values from column range to jagged array (Data(0) & Data(1)).
Dim ubc As Long: ubc = UBound(Cols)
Dim Data As Variant: ReDim Data(ubc)
Dim j As Long
For j = 0 To ubc
getRange(Data(j), rng.Offset(, src.Columns(Cols(j)).Column _
- src.Columns(srcLastRowCol).Column))
If IsEmpty(Data) Then Exit Sub
Next
' Search Data(0) Array for string contained in Question Cell
' and write result from Data(1) Array to Answer Cell.
Dim tgt As Worksheet: Set tgt = wb.Worksheets(tgtName)
Dim Sentence As String: Sentence = tgt.Range(queCell).Value
Dim i As Long
For i = 1 To UBound(Data(0))
If Sentence = "" Then Exit For
If Trim(Data(0)(i, 1)) <> "" Then
If InStr(1, Sentence, Trim(Data(0)(i, 1)), vbTextCompare) > 0 Then
tgt.Range(ansCell).Value = Data(1)(i, 1)
Exit Sub
End If
End If
Next i
' If string not found, write Not Found Message to Answer Cell.
tgt.Range(ansCell).Value = msg
End Sub
' Writes the values of a range to a 2D one-based array.
Sub getRange(ByRef Data As Variant, DataRange As Range)
Data = Empty
If DataRange Is Nothing Then Exit Sub
If DataRange.Rows.Count > 1 Or DataRange.Columns.Count > 1 Then
Data = DataRange.Value
Else
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = DataRange.Value
End If
End Sub
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Me.Range(queCell), Target) Is Nothing Then
writeAnswer
End If
End Sub
I know this topic has been asked about before but nothing quite covers what I need. So here's the thing..
I have two workbooks. One is exported from another program which shows a staff member's Surname, first name, email and which ward they work on.
[Workbook1 example]
The second is the full staff list which has the same details but also a check list column.
[Workbook2 example]
What I need is a macro (probably a vlookup) which takes the information from the workbook1, checks against surname, first name and ward on workbook2 to ensure that it is the correct member of staff, copies the email onto workbook 2 and also fills the checklist column on workbook 2 to "Yes".
I'm afraid I am at a loss as to how to incorporate all of this together. Please help.
This is what I have so far but my knowledge is limited and did not know how to proceed.
Private Sub UpdateTraining_Click()
Dim I As Integer
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet
Dim Wb As Workbook
Dim CopyData As String
Dim RwCnt As Long
Dim RwCnt2 As Long
Dim Rw As Long
Dim Clm As Long
Dim SName As String
Dim FName As String
Dim Wrd As String
Dim vArr
Dim ClmLet As String
Set Ws1 = Workbooks("Nursing Docs Training Record.xlsm").Worksheets("Staff Training Record")
Set Ws2 = Workbooks("Nursing Docs Training Record.xlsm").Worksheets("Do Not Use")
Workbooks.Open ("C:\TypeformNursingDocumentation.xlsx")
Set Ws3 = Workbooks("TypeformNursingDocumentation.xlsx").Worksheets("tWeXNp")
RwCnt = Ws3.Cells(Rows.Count, 1).End(xlUp).Row
RwCnt2 = Ws1.Cells(Rows.Count, 1).End(xlUp).Row
Rw = Ws3.Range("F2").Row
Clm = Ws3.Range("F2").Column
Table1 = Ws3.Range("F2:F" & RwCnt)
vArr = Split(Cells(1, Clm).Address(True, False), "$")
ClmLet = vArr(0)
For Each cl In Table1
Ws3.Range(ClmLet & Rw).Select
SName = ActiveCell.Value
FName = ActiveCell.Offset(0, -1).Value
Wrd = ActiveCell.Offset(0, -4).Value
Rw = Rw + 1
Next cl
End Sub
You can achieve this with formulas but then you have to open Workbook1 for the formulas to work in Workbook2. So below approach uses VBA to achieve the results
Copy the below UDF in a module in Workbook2:
Sub UpdateMyList()
Dim oSourceWB As Workbook
Dim oSourceR As Variant
Dim iTotSRows&, iTotCRows&, iCC&, iSC&
Dim oCurR As Variant
Application.ScreenUpdating = False
' First lets get source data
Set oSourceWB = Workbooks.Open("C:\Temp\EmpLookup.xlsx", ReadOnly:=True) ' Change the source file name
With oSourceWB.Worksheets("Sheet1") ' Change the source sheet name
iTotSRows = .Range("A" & .Rows.count).End(xlUp).Row
oSourceR = .Range("A2:G" & iTotSRows)
End With
oSourceWB.Close False
' We now need the data from the sheet in this workbook to compare against
With ThisWorkbook.Worksheets("Sheet8") ' Change the sheet name to the sheet in your workbook
iTotCRows = .Range("A" & .Rows.count).End(xlUp).Row
oCurR = .Range("A2:H" & iTotCRows)
End With
' Next, lets compare and update fields
For iCC = 1 To UBound(oCurR)
For iSC = 1 To UBound(oSourceR)
If (oCurR(iCC, 1) = oSourceR(iSC, 6)) And (oCurR(iCC, 2) = oSourceR(iSC, 5)) And (oCurR(iCC, 5) = oSourceR(iSC, 2)) Then
oCurR(iCC, 7) = oSourceR(iSC, 7)
oCurR(iCC, 8) = "Yes"
Exit For
End If
Next
Next
Application.ScreenUpdating = True
' Finally, lets update the sheet
ThisWorkbook.Worksheets("Sheet8").Range("A2:H" & iTotCRows) = oCurR
End Sub
I've commented on the lines where you need to change references to workbook or worksheets. As long as you have updated the workbook and worksheet references, this should give you the desired results
I built the above UDF based on the columns as you provided in your question. If the columns change, you will have to modify the UDF or get the columns dynamically
You can use and If(Countif()) style function, where the countif checks for the presence of your value, and the if will return true if it is a match, then you can use the if true / false values accordingly. Let me know if you need more details but it could look something like this =IF(COUNTIF(The selected cell is in the selected range),"Yes", "No"). Then record this as a macro and copy the code into yours.