Hello,

I have this great macro but it was used to copy row that matched TEXT value.

I have other similar need but I want it to look for a date value instead of text.

My problem is problebly this: If (level = "")

But cant figure out what to replace it with

Any sugestions ?

Sub CopyToSheets()
   'Declare associative array of "Levels".
   'Note: Must enable "Microsoft Scripting Runtime" library via "Tools" >
   '"References" in order to use Dictionary object.
   Dim RowPositions As Scripting.Dictionary
   Set RowPositions = New Scripting.Dictionary

   Dim MasterWsName As String
   MasterWsName = ActiveSheet.Name

   'Specify which row to start reading from source worksheet
   RowPositions.Add Key:=MasterWsName, Item:=3

   Dim active, level As String
   Do
      'Exit if no more data
      level = Worksheets(MasterWsName).Range("A" & RowPositions.Item(MasterWsName)).Value
      If (level = "") Then Exit Do

      'Exit if participant is not active
      active = Worksheets(MasterWsName).Range("F" & RowPositions.Item(MasterWsName)).Value
      If (active = "n") Then GoTo NextRow

      'Create new key only if it doesn't exist
      If (Not RowPositions.Exists(level)) Then
         RowPositions.Add Key:=level, Item:=7
      End If

      'Create new worksheet if it doesn't exist
      Dim ws As Worksheet
      Set ws = Nothing
      On Error Resume Next
      Set ws = Worksheets(level)
      If ws Is Nothing Then
         ActiveWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
         ActiveSheet.Name = level
      End If

      'Copy from source worksheet and paste to destination worksheet
      Worksheets(MasterWsName).Rows(RowPositions.Item(MasterWsName) & ":" & RowPositions.Item(MasterWsName)).Copy _
         Destination:=Worksheets(level).Range("A" & RowPositions.Item(level))

      'Step to next destination row
      RowPositions.Item(level) = RowPositions.Item(level) + 1

NextRow:
      'Step to next source row
      RowPositions.Item(MasterWsName) = RowPositions.Item(MasterWsName) + 1
   Loop

   'Copy header rows from master worksheet to newly-created worksheets, then
   'position cursor on cell A6.
   For Each Key In RowPositions
      If (Key = MasterWsName) Then GoTo NextKey
      Worksheets(MasterWsName).Rows("2").Copy Destination:=Worksheets(Key).Range("A6")
      Worksheets(Key).Columns("A:H").AutoFit
NextKey:
   Next

   Worksheets(MasterWsName).Select
   Range("A1").Select
End Sub