Hi,

I've post previously about a similar topic so sorry if anyone sees it as a repeat.

Currently I have a list of active changes in a manufacturing environment, and have a column with location. I'm running a set of IF statements, to copy out rows based on location. So plant 2, will copy into plant 2 work sheet for example. Here is the code:


Sub As_Of_Analysis_Sorting()

Dim r As Long

'Assigning the sheet that needs to be searched
With Sheets("All Active Changes")

  'Setting the range
  For r = .Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
  
    'Searching the range for "action data"
    If .Range("C" & r).Value = "Press" Then
      .Rows(r).Copy Destination:=Sheets("Press").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
      Sheets("Press").Cells(Rows.Count, "A").End(xlUp).End(xlToRight).Offset(0, 1) = Date
      
    End If
    
        If .Range("C" & r).Value = "Plant 2N" Then
      .Rows(r).Copy Destination:=Sheets("Plant 2N").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
      Sheets("Plant 2N").Cells(Rows.Count, "A").End(xlUp).End(xlToRight).Offset(0, 1) = Date
      
    End If
    
            If .Range("C" & r).Value = "Plant 2S" Then
      .Rows(r).Copy Destination:=Sheets("Plant 2S").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
      Sheets("Plant 2S").Cells(Rows.Count, "A").End(xlUp).End(xlToRight).Offset(0, 1) = Date
      
    End If
    
            If .Range("C" & r).Value = "Plant 3" Then
      .Rows(r).Copy Destination:=Sheets("Plant 3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
      Sheets("Plant 3").Cells(Rows.Count, "A").End(xlUp).End(xlToRight).Offset(0, 1) = Date
      
    End If
    
            If .Range("C" & r).Value = "Plant 4" Then
      .Rows(r).Copy Destination:=Sheets("Plant 4").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
      Sheets("Plant 4").Cells(Rows.Count, "A").End(xlUp).End(xlToRight).Offset(0, 1) = Date
      
    End If
    
                If .Range("C" & r).Value = "Plant 5" Then
      .Rows(r).Copy Destination:=Sheets("Plant 5").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
      Sheets("Plant 5").Cells(Rows.Count, "A").End(xlUp).End(xlToRight).Offset(0, 1) = Date
      
    End If
    
                If .Range("C" & r).Value = "Plant 6" Then
      .Rows(r).Copy Destination:=Sheets("Plant 6").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
      Sheets("Plant 6").Cells(Rows.Count, "A").End(xlUp).End(xlToRight).Offset(0, 1) = Date
      
    End If
    
  Next r
End With

End Sub
Problem is I want to run this when the work book is opened and closed, but every time it is repeating the data. Is there a way to stop this without cutting it from the active changes list.

The idea is to copy a row from beginning to end, an exact copy, to a new sheet based on location, then add. an extra row on the end, within each separate sheet. So for example:

Search a whole sheet, and copy a row from a to g based on location in row C, then have a space for a comment on the sheet, in each individual?

Any ideas thanks