Thread: VBA to copy data into other sheets based on specific criteria’s

In Dashboard_1, you have marked the code for Closed and Open in green (commented it). This will prevent the code from running. Any specific reason why you have done so?

The date format that you gave me in the dummy file was dd-mmm but in this file, its with a timestamp as well. So i just had to change a few things and got it working. Use this code -

Option Explicit
Dim userdate As Date
Dim lrow As Long
Dim i As Long
Dim lastrow As Long

Sub copy_data()

Application.ScreenUpdating = False

userdate = InputBox("Please enter the date in format mm/dd/yy", "Enter Date")

With Worksheets("Sheet1")
    If Not Evaluate("ISREF('Received'!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Received"
        .Rows("1:1").Copy Worksheets("Received").Range("A1")
    Else
        lastrow = Worksheets("Received").Range("A" & Rows.Count).End(xlUp).Row
        Worksheets("Received").Range("A2:U" & lastrow).ClearContents
        .Rows("1:1").Copy Worksheets("Received").Range("A1")
    End If
    
    lrow = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lrow
        If .Range("L" & i).Value Like userdate & "*" Then
            If .Range("S" & i).Value = "Team A" Or .Range("S" & i).Value = "Team B" Or .Range("S" & i).Value = "Team C" Or _
                .Range("S" & i).Value = "Team D" Or .Range("S" & i).Value = "Team E" Then
                    .Range("A" & i & ":U" & i).Copy Worksheets("Received").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            End If
        End If
    Next i
    
    Worksheets("Received").Cells.EntireColumn.AutoFit
    
    If Not Evaluate("ISREF('Closed'!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Closed"
        .Rows("1:1").Copy Worksheets("Closed").Range("A1")
    Else
        lastrow = Worksheets("Closed").Range("A" & Rows.Count).End(xlUp).Row
        Worksheets("Closed").Range("A2:U" & lastrow).ClearContents
        .Rows("1:1").Copy Worksheets("Received").Range("A1")
    End If

     For i = 2 To lrow
        If .Range("N" & i).Value Like userdate & "*" Then
            If .Range("S" & i).Value = "Team A" Or .Range("S" & i).Value = "Team B" Or .Range("S" & i).Value = "Team C" Or _
                .Range("S" & i).Value = "Team D" Or .Range("S" & i).Value = "Team E" Then
                If .Range("U" & i).Value = "Closed" Or .Range("U" & i).Value = "Closure Pending" Or .Range("U" & i).Value = "Verified closed" Then
                    .Range("A" & i & ":U" & i).Copy Worksheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                End If
            End If
        End If
    Next i
    
    Worksheets("Closed").Cells.EntireColumn.AutoFit

    If Not Evaluate("ISREF('Open'!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Open"
        .Rows("1:1").Copy Worksheets("Open").Range("A1")
    Else
        lastrow = Worksheets("Open").Range("A" & Rows.Count).End(xlUp).Row
        Worksheets("Open").Range("A2:U" & lastrow).ClearContents
        .Rows("1:1").Copy Worksheets("Received").Range("A1")
    End If

    For i = 2 To lrow
        If .Range("S" & i).Value = "Team A" Or .Range("S" & i).Value = "Team B" Or .Range("S" & i).Value = "Team C" Or _
                .Range("S" & i).Value = "Team D" Or .Range("S" & i).Value = "Team E" Then
                If .Range("U" & i).Value = "New" Or .Range("U" & i).Value = "Open" Or .Range("U" & i).Value = "Pending" Then
                    .Range("A" & i & ":U" & i).Copy Worksheets("Open").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                End If
        End If
    Next i
    
    Worksheets("Open").Cells.EntireColumn.AutoFit

End With

Application.ScreenUpdating = True

End Sub

Yes exactly. Next time ensure that you give the data in the same format as your original file, it works faster.