Getting Values Based on Conditions

[Randy1234]

I have a spreadsheed that is pulling data from another worksheet, sorting it then using that data to fill in the cells on my report.

1. Column "a" is a project name and Column "b" of the is a start date.
2. Columns "c" through "ad" are weeks where
Row 2 contains dates for the begining of each week
Row 3 contains dates for the end of each week

so my report looks a little like this:

A B C D E
1
2 2/06/2006 2/13/2006 2/20/2006
3 2/12/2006 2/19/2006 2/26/2006

4 Project 1 2/06/2006
5 Project 2 2/15/2006
6 Project 3 2/24/2006

I am using the following code:

Sub Starts()

Dim rng As Range
Dim Cell As Range

Set rng = Range("C6:AD1505")

For Each Cell In rng
        With Cell
            If Cells(.Row, "B").Value = "" Then
            Exit Sub
            ElseIf Cells(.Row, "B").Value >= Cells("2", .Column).Value And Cells(.Row, "B").Value <= Cells("3", .Column).Value Then
            Cell.Value = Worksheets("Sheet3").Cells(.Row, "B")
            End If
        End With
    Next Cell
    
End Sub

My resulting report now looks like this:

A B C D E
1
2 2/06/2006 2/13/2006 2/20/2006
3 2/12/2006 2/19/2006 2/26/2006

4 Project 1 2/06/2006 5
5 Project 2 2/15/2006 6 6
6 Project 3 2/24/2006 5 5 5

I think I am missing something that I can't seem to figure out. I need the report to return these results:

A B C D E
1
2 2/06/2006 2/13/2006 2/20/2006
3 2/12/2006 2/19/2006 2/26/2006

4 Project 1 2/06/2006 5
5 Project 2 2/15/2006 6
6 Project 3 2/24/2006 5



Sorry so lengthy, I just wanted to be clear. Any help available would be greatly appreciated.

Thanks

 

[Randy1234]

I fixed my own problem, but it loops rather slow. If anyone has an idea to spped it up a bit I would greatly appreciate it. Here is the code I am using:

Sub Starts()

Dim rng As Range
Dim Cell As Range

Set rng = Range("C6:AD1505")

For Each Cell In rng
        With Cell
            If Cells(.Row, "B").Value = "" Then
            Exit Sub
            ElseIf Cells(.Row, "B").Value >= Cells("2", .Column).Value And Cells(.Row, "B").Value <= Cells("3", .Column).Value Then
            Cell.Value = Worksheets("Sheet3").Cells(.Row, "B")
            Else
                Cell.Value = ""
                        
            End If
        End With
    Next Cell
    
 Application.ScreenUpdating = True
 
End Sub