Sid
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 |
---|---|---|---|
consolidate from multiple folders | 5 | 39 | |
FormulaArray VBA Issue | 6 | 17 | |
Steps to program a particular database app using access and any programming language. | 16 | 33 | |
Help with Excel formula | 6 | 35 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
20 Experts available now in Live!