delete old files from, folder and list, shift cells up under conditions.

[BRB1983]

the issue is that the code is is deleting more than i ask for. it also deletes a cell that is not colored.

Sub delete_test_2()
Dim MyFolder As String
Dim cell As Range
Application.ScreenUpdating = False
    With Sheets("Delete Revs")
    MyFolder = .Range("K1").Value & "\"
        For Each cell In .Range("C3:C17")
            If cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "A" Then
                Kill MyFolder & cell.Value & ".pdf"
                cell.Offset(0, 1).Delete xlShiftUp
                cell.Offset(0, 2).Delete xlShiftUp
                cell.Delete xlShiftUp
            End If
        Next cell
            For Each cell In .Range("C3:C17")
                If cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "0" Then
                    Kill MyFolder & cell.Value & ".pdf"
                    cell.Offset(0, 1).Delete xlShiftUp
                    cell.Offset(0, 2).Delete xlShiftUp
                    cell.Delete xlShiftUp
                End If
            Next cell

 

[Joe4]

You are checking one cell, then telling to delete three cells:

                cell.Offset(0, 1).Delete xlShiftUp
                cell.Offset(0, 2).Delete xlShiftUp
                cell.Delete xlShiftUp

So it is deleting the cell that meets the conditions, and the two cells to the right of it.

 

[BRB1983]

yes that is what i want it to do. it is deleting cells that did not meet the conditions.

 

[Fluff]

How about

Sub BRB1983()
Dim MyFolder As String
Dim cell As Range, Rng As Range
Application.ScreenUpdating = False
    With Sheets("Delete Revs")
    MyFolder = .Range("K1").Value & "\"
        For Each cell In .Range("C3:C17")
            If cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "A" Then
                Kill MyFolder & cell.Value & ".pdf"
                If Rng Is Nothing Then Set Rng = cell.Resize(, 3) Else Set Rng = Union(Rng, cell.Resize(, 3))
             ElseIf cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "0" Then
                 Kill MyFolder & cell.Value & ".pdf"
                If Rng Is Nothing Then Set Rng = cell.Resize(, 3) Else Set Rng = Union(Rng, cell.Resize(, 3))
             End If
         Next cell
         If Not Rng Is Nothing Then Rng.Delete xlUp
End Sub

 

[BRB1983]

here is code from start to finish with the issues. also conditional formatting is involved.

Option Explicit

Sub LOAD_FILES_TO_DELETE_OLD_REVs()
Dim MyFolder As String
Dim MyFile As String
Dim a As Integer
Dim fldr As String
Dim LAStrow As Long
Dim strtcell As Range
Range("D2") = "REV"
Application.StatusBar = True
    Application.ScreenUpdating = False
fldr = Sheets("sheet1").Range("K1").Value
MyFolder = fldr
MyFile = Dir(MyFolder & "\" & "*.*")
a = 2
Do While MyFile <> ""
    a = a + 1
    Cells(a, 3).Value = Left(MyFile, Len(MyFile) - 4)
    MyFile = Dir
Loop
LAStrow = Range("C" & Rows.Count).End(xlUp).Row
Range("D3:D" & LAStrow).Formula = "=right(C3,1)"
Range("E3:E" & LAStrow).Formula = "=left(C3,len(C3)-6)"
'MsgBox "FILE LOADING COMPLETE."
Worksheets("sheet1").Columns("A:f").AutoFit
Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub




Sub delete_test_2()
Dim MyFolder As String
Dim cell As Range
Application.ScreenUpdating = False
    With Sheets("sheet1")
    MyFolder = .Range("K1").Value & "\"
        For Each cell In .Range("C3:C17")
            If cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "A" Then
                Kill MyFolder & cell.Value & ".pdf"
                cell.Offset(0, 1).Delete xlShiftUp
                cell.Offset(0, 2).Delete xlShiftUp
                cell.Delete xlShiftUp
            End If
        Next cell
            For Each cell In .Range("C3:C17")
                If cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "0" Then
                    Kill MyFolder & cell.Value & ".pdf"
                    cell.Offset(0, 1).Delete xlShiftUp
                    cell.Offset(0, 2).Delete xlShiftUp
                    cell.Delete xlShiftUp
                End If
            Next cell
'                For Each cell In .Range("C3:C17")
'                    If cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "1" Then
'                        Kill MyFolder & cell.Value & ".pdf"
'                        cell.Offset(0, 1).Delete xlShiftUp
'                        cell.Offset(0, 2).Delete xlShiftUp
'                        cell.Delete xlShiftUp
'                    End If
'                Next cell
'                    For Each cell In .Range("C3:C17")
'                        If cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "2" Then
'                            Kill MyFolder & cell.Value & ".pdf"
'                            cell.Offset(0, 1).Delete xlShiftUp
'                            cell.Offset(0, 2).Delete xlShiftUp
'                            cell.Delete xlShiftUp
'                        End If
'                    Next cell
'                        For Each cell In .Range("C3:C17")
'                            If cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "3" Then
'                                Kill MyFolder & cell.Value & ".pdf"
'                                cell.Offset(0, 1).Delete xlShiftUp
'                                cell.Offset(0, 2).Delete xlShiftUp
'                                cell.Delete xlShiftUp
'                            End If
'                        Next cell
'                            For Each cell In .Range("C3:C17")
'                                If cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "4" Then
'                                    Kill MyFolder & cell.Value & ".pdf"
'                                    cell.Offset(0, 1).Delete xlShiftUp
'                                    cell.Offset(0, 2).Delete xlShiftUp
'                                    cell.Delete xlShiftUp
'                                End If
'                            Next cell
'                                For Each cell In .Range("C3:C17")
'                                    If cell.Interior.Color = RGB(255, 255, 255) And cell.Offset(0, 1) = "5" Then
'                                        Kill MyFolder & cell.Value & ".pdf"
'                                        cell.Offset(0, 1).Delete xlShiftUp
'                                        cell.Offset(0, 2).Delete xlShiftUp
'                                        cell.Delete xlShiftUp
'                                    End If
'                                Next cell
    End With
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Did you see my suggestion in post#4?

 

[BRB1983]

yes just tried it said file not found so i blocked the kill file and it delete a file name from the list on the sheet that does not met the conditions.
each file has a REV. REV 0, REV 1, REV 2. Rev 2 being the newest one. so with that file name i need REV 0 & 1 to be deleted. there is one file, the first file name that only has one REV. so this one is not colored and it still deletes it.

 

[Fluff]

Do you have any merged cells?

 

[BRB1983]

None merged.
I'm thinking my safest bet would try to first copy the file names that need to be deleted to a different column and then delete those files.

 

[Fluff]

In your previous thread you were looking for cells that were red, now you are looking for cells that do not have a fill colour, is that what you wanted?