hi
this is the code that's looks at sheet2 and makes new sheets depending on type ,the macrodupagain is the 10th delete macro ive tried,this is self recorded but does not always work
cheers colin
Dim lrow As Long
Dim i As Long
Dim sname As String
Application.ScreenUpdating = False
With Worksheets("sheet2")
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lrow
' If .Range("f" & i).Value = "COMPLETED" Then
sname = .Range("B" & i).Value
If Not Evaluate("ISREF('" & sname & "'!A1)") Then
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = sname
.Rows("1:1").Copy Worksheets(sname).Range("A1")
End If
.Rows(i & ":" & i).Copy
Worksheets(sname).Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlFormats
Worksheets(sname).Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlValues
Application.CutCopyMode = 0
Worksheets(sname).Columns.AutoFit
Next i
End With
Macrodupagain
Macrodupagain Macro
'
'
Sheets("PUMP").Select
Range("A1:M170").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
' Range("A1:M170").AdvancedFilter Action:=xlFilterInPlace, Unique:=False
' Range("A1:M170").AdvancedFilter Action:=xlFilterInPlace, Unique:=False
' Range("A1:M170").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Sheets("VESSEL").Select
Range("A1:M170").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Sheets("MOTOR").Select
Range("A1:M170").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Sheets("GEARBOX").Select
Range("A1:M170").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Sheets("RELIEF VALVE").Select
Range("A1:M170").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Sheets("VALVE").Select
Range("A1:M170").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
[/CODE]
Bookmarks