Snasui Excel Forum

Code: Select all

Dim l As Long, tg As Range
Dim source As Range, r As Range
Dim dd As Byte, pd As Byte
With Sheets("data")
    Set source = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    l = source.Count
    With .Parent.Sheets("schedule")
        .Range("a4").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count) _
            .ClearContents
        With .Range("a4").Resize(l)
            .Value = source.Value
            .RemoveDuplicates Columns:=1, Header:=xlNo
        End With
        Set tg = .Range("a4", .Range("a" & .Rows.Count).End(xlUp))
        For Each r In source
            l = Application.Match(r, tg, 0) - 1
            dd = Left(r.Offset(0, 5), 2)
            pd = Left(r.Offset(0, 6), 2)
            If pd <= dd Then
                .Range("b4").Offset(l, pd).Value = "R/D"
            Else
                .Range("b4").Offset(l, dd).Value = "R"
                .Range("b4").Offset(l, pd).Value = "D"
            End If
        Next r
    End With
End With

Code: Select all

 If pd <= dd Then
                .Range("b4").Offset(l, dd).Value = "R/D"
            Else