Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.
Sub findabsences()
Dim wkb1 As Workbook, wkb2 As Workbook
Dim aCell As Range, bCell As Range
Dim i As Long
Dim strSearch As String
Application.ScreenUpdating = False
Set wkb1 = ActiveWorkbook
LastRowWs1 = wkb1.Sheets(1).Range("A" & Rows.Count).End(xlUp)
'~~> Change the path as applicable
Set wkb2 = Workbooks.Open("C:\Inventory and Spares - Template last.xls")
LastRowWs2 = wkb2.Sheets(1).Range("S" & Rows.Count).End(xlUp)
Set bCell = wkb2.Sheets(1).Range("S2:S" & LastRowWs2)
For i = 3 To LastRowWs1
strSearch = wkb1.Sheets(1).Range("A" & i).Value
Set aCell = bCell.Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
aCell.Interior.ColorIndex = 3
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub findabsences()
Dim wkb1 As Workbook, wkb2 As Workbook
Dim aCell As Range, bCell As Range
Dim i As Long
Dim strSearch As String
Application.ScreenUpdating = False
Set wkb1 = ActiveWorkbook
LastRowWs1 = wkb1.Sheets(1).Range("S" & Rows.Count).End(xlUp)
Set aCell = wkb1.Sheets(1).Range("S2:S" & LastRowWs1)
'~~> Change the path as applicable
Set wkb2 = Workbooks.Open("C:\01Manufacturers.xls")
LastRowWs2 = wkb2.Sheets(1).Range("A" & Rows.Count).End(xlUp)
For i = 2 To LastRowWs1
strSearch = wkb1.Sheets(1).Range("S" & i).Value
Set bCell = aCell.Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not bCell Is Nothing Then
bCell.Interior.ColorIndex = 3
End If
Next i
Application.ScreenUpdating = True
End Sub
fname = ThisWorkbook.Path
ChDir ThisWorkbook.Path
for i to lastrow
Sheet1.Range("T1").FormulaR1C1 = "=VLOOKUP(RC[-1],'[01Manufacturers.xls]Sheet1'!C1,1,FALSE)"
Sub findabsences2()
Dim i As Long
fname = ThisWorkbook.Path
ChDir ThisWorkbook.Path
LastRow = ActiveSheet.Range("S" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
Sheet1.Range("T" & i).FormulaR1C1 = "=VLOOKUP(RC[-1],'[01Manufacturers.xls]Sheet1'!C1,1,FALSE)"
Next
Range("T:T").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
For i = 2 To LastRow
If Cells(i, "T").Text = "#N/A" Then
With Range("S" & i).Interior
.Pattern = xlSolid
.Color = 255
End With
End If
Next
End Sub
Sub findabsences2()
Application.ScreenUpdating = False
Dim i As Long
fname = ThisWorkbook.Path
ChDir ThisWorkbook.Path
LastRow = ActiveSheet.Range("S" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
Sheet1.Range("CA" & i).FormulaR1C1 = "=VLOOKUP(RC[-60],'[01Manufacturers.xls]Sheet1'!C1,1,FALSE)"
Sheet1.Range("CB" & i).FormulaR1C1 = "=VLOOKUP(RC[-72],'[03b - SupplierSites.xls]Export Worksheet'!C1,1,FALSE)"
Sheet1.Range("CC" & i).FormulaR1C1 = "=VLOOKUP(RC[-69],'[UOM INFOR.xls]Sheet1'!C1,1,FALSE)"
Sheet1.Range("CD" & i).FormulaR1C1 = "=VLOOKUP(RC[-66],'[INFOR CURRENCY.xls]Sheet1'!C1,1,FALSE)"
Sheet1.Range("CE" & i).FormulaR1C1 = "=VLOOKUP(RC[-51],'[19a - Categories.xlsx]Categories'!C1,1,FALSE)"
Next
Range("CA:CE").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
For i = 2 To LastRow
If Cells(i, "CA").Text = "#N/A" Then
With Range("S" & i).Interior
.Pattern = xlSolid
.Color = 255
End With
End If
If Cells(i, "CB").Text = "#N/A" Then
With Range("H" & i).Interior
.Pattern = xlSolid
.Color = 255
End With
End If
If Cells(i, "CC").Text = "#N/A" Then
With Range("L" & i).Interior
.Pattern = xlSolid
.Color = 255
End With
End If
If Cells(i, "CD").Text = "#N/A" Then
With Range("P" & i).Interior
.Pattern = xlSolid
.Color = 255
End With
End If
If Cells(i, "CE").Text = "#N/A" Then
With Range("AF" & i).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
Application.ScreenUpdating = True
End Sub
Sub findabsences()
Dim wkb1 As Workbook, wkb2 As Workbook
Dim aCell As Range, bCell As Range
Dim i As Long
Dim strSearch As String
Application.ScreenUpdating = False
Set wkb1 = ActiveWorkbook
LastRowWs1 = wkb1.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'~~> Change the path as applicable
Set wkb2 = Workbooks.Open("C:\Inventory-and-Spares---Template-.xlsx")
LastRowWs2 = wkb2.Sheets(1).Range("S" & Rows.Count).End(xlUp).Row
Set bCell = wkb2.Sheets(1).Range("S2:S" & LastRowWs2)
For i = 3 To LastRowWs1
strSearch = wkb1.Sheets(1).Range("A" & i).Value
Set aCell = bCell.Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
aCell.Interior.ColorIndex = 3
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub findabsences()
Dim wkb1 As Workbook, wkb2 As Workbook
Dim aCell As Range, bCell As Range, cCell As Range, rngColor As Range
Dim i As Long
Dim strSearch As String
Dim ExitLoop As Boolean
Application.ScreenUpdating = False
Set wkb1 = ActiveWorkbook
LastRowWs1 = wkb1.Sheets(1).Range("S" & Rows.Count).End(xlUp).Row
Set aCell = wkb1.Sheets(1).Range("S2:S" & LastRowWs1)
'~~> Change the path as applicable
Set wkb2 = Workbooks.Open("C:\01Manufacturers.xlsx")
LastRowWs2 = wkb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRowWs2
strSearch = wkb2.Sheets(1).Range("A" & i).Value
Set bCell = aCell.Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
ExitLoop = False
If Not bCell Is Nothing Then
Set cCell = bCell
If rngColor Is Nothing Then
Set rngColor = bCell
Else
Set rngColor = Union(rngColor, bCell)
End If
Do While ExitLoop = False
Set bCell = aCell.FindNext(After:=bCell)
If Not bCell Is Nothing Then
If bCell.Address = cCell.Address Then Exit Do
If rngColor Is Nothing Then
Set rngColor = bCell
Else
Set rngColor = Union(rngColor, bCell)
End If
Else
ExitLoop = True
End If
Loop
End If
Next i
rngColor.Interior.ColorIndex = 3
wkb2.Close savechanges:=False
Application.ScreenUpdating = True
End Sub
Sub findabsences()
Dim wkb1 As Workbook, wkb2 As Workbook
Dim aCell As Range, bCell As Range
Dim i As Long
Dim strSearch As String
Application.ScreenUpdating = False
Set wkb1 = ActiveWorkbook
LastRowWs1 = wkb1.Sheets(1).Range("S" & Rows.Count).End(xlUp).Row
'~~> Change the path as applicable
Set wkb2 = Workbooks.Open("C:\01Manufacturers.xlsx")
LastRowWs2 = wkb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
Set aCell = wkb2.Sheets(1).Range("A2:A" & LastRowWs1)
For i = 2 To LastRowWs1
strSearch = wkb1.Sheets(1).Range("S" & i).Value
Set bCell = aCell.Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If bCell Is Nothing Then
wkb1.Sheets(1).Range("S" & i).Interior.ColorIndex = 3
End If
Next i
wkb2.Close savechanges:=False
Application.ScreenUpdating = True
End Sub
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Finding a closest match in Excel | 7 | 42 | |
Batch file or script with password | 22 | 42 | |
Excel Cell Total | 3 | 20 | |
Copying from excel I am getting extra text | 11 | 36 |
Join the community of 500,000 technology professionals and ask your questions.