Need to loop missing out blank cells

[mdos1]

Hi,

i have a great macro that works well but, my lookup cells will now have a number of blank cells which i want the lookup to ignore. I have also just named the range of cell but don't know how to change it in the macro.

Any ideas?

Thanks Mark

Dim sIn As Worksheet
Dim sOut As Worksheet
Dim rIn As Integer
Dim cIn As Integer
Dim rOut As Integer
Dim cOut As Integer
Dim Num As Integer
Dim NewValue
Dim Found As Boolean
Dim SearchRange As Range

'set the two worksheets
Set sIn = Sheets("Schedule")
Set sOut = Sheets("Totals")

'start input from F19
rIn = 7

cIn = 6

'start output from A10
rOut = 24
cOut = 1
Num = 0

'clear ouput range
Range(sOut.Cells(rOut, cOut), sOut.Cells(rOut + 1000, cOut)).ClearContents

'this is needed for the Match function which returns an error if not found
On Error Resume Next

'run through input list
Do While sIn.Cells(rIn, cIn).Value <> ""
NewValue = sIn.Cells(rIn, cIn).Value

'try to find the item in the output list
Set SearchRange = Range(sOut.Cells(rOut, cOut), sOut.Cells(rOut + Num, cOut))

Found = False
Found = IsNumeric(Application.WorksheetFunction.Match(NewValue, SearchRange, 0))

'add item to destination
If Not Found Then
sOut.Cells(rOut + Num, cOut).Value = NewValue
Num = Num + 1
End If

rIn = rIn + 1
Loop

On Error GoTo 0

MsgBox "Completed processing. Unique items written:" + Str(Num)

' Sub SORT()
'
' SORT Macro
'
'
Range("A24:A252").Select
ActiveWorkbook.Worksheets("Totals").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Totals").Sort.SortFields.Add Key:=Range("A24:A42") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Totals").Sort
.SetRange Range("A24:A42")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With