Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.
Become a Premium Member and unlock a new, free course in leading technologies each month.
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
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
Join the community of 500,000 technology professionals and ask your questions.