dmelt253
05-26-2016, 10:07 AM
First off a little background:I work for a company that provides sustainment services for vehicles. If certain parts breakdown on these vehicles it makes them Non Mission Capable (NMC) and so these parts in particular are high priority. I run a receiving report out of Cognos which shows me parts that were received in the last 7 days. In the first column is a list of Document #'s which are basically like serial numbers that tell which project these parts belong too. The first 14 characters of these doc #'s is the most important but sometimes a letter is tacked on for a split shipment. Everyday I receive an NMC report which is a list of parts that deadline a vehicle by making it non mission capable. The name of this report remains constant: NMC Report [today's date]So here is what I'm trying to do:With both the receiving report from Cognos and the NMC report open I would like to run a macro that takes each document number on the receiving report (range = ("A2:A50")) and searches the entire NMC report workbook (there are multiple worksheets) and if it finds a match it highlights that cell in the receiving report yellow and then moves onto the next cell and repeats the search till all the used cells in the receiving report have been searched. The document numbers are unique so there will not be multiple values to find in the NMC report.Here is the code I have so far but I keep getting a Compile error: Else without If?
Option Explicit
Sub NMC_Check()
'
' NMC_Check Macro
'
'
Dim sWB As Workbook
Dim sRange As Range
Dim sCell As Range
Dim sWS As Worksheet
Dim sWhat As String
Dim rFound As Range
For Each sWB In Application.Workbooks
If Left(sWB.Name, 3) = "NMC" Then Exit For
Next sWB
Set sRange = Range("A2:A50")
For Each sCell In sRange
If Len(sCell.Value) = 0 Then
MsgBox ("No NMC Parts")
ElseIf Left(sCell.Value, 7) = "W909536" Then
sWhat = sCell.Value
For Each sWS In sWB
sWS.UsedRange.Find(sWhat, LookIn:=xlValues) = rFound
If rFound Is Nothing Then
Exit For
ElseIf Len(rFound.Values) > 0 Then
sCell.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next sWS
End If
Next sCell
End Sub
Option Explicit
Sub NMC_Check()
'
' NMC_Check Macro
'
'
Dim sWB As Workbook
Dim sRange As Range
Dim sCell As Range
Dim sWS As Worksheet
Dim sWhat As String
Dim rFound As Range
For Each sWB In Application.Workbooks
If Left(sWB.Name, 3) = "NMC" Then Exit For
Next sWB
Set sRange = Range("A2:A50")
For Each sCell In sRange
If Len(sCell.Value) = 0 Then
MsgBox ("No NMC Parts")
ElseIf Left(sCell.Value, 7) = "W909536" Then
sWhat = sCell.Value
For Each sWS In sWB
sWS.UsedRange.Find(sWhat, LookIn:=xlValues) = rFound
If rFound Is Nothing Then
Exit For
ElseIf Len(rFound.Values) > 0 Then
sCell.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next sWS
End If
Next sCell
End Sub