Thread: Need to delete all rows containing 'Christmas'!

Hello everybody,

I have about 200 excel files each with numerous worksheets within each, labeled 'stock 1' to 'stock 45' for example. Now within each worksheet, i would like to delete the rows which contain specific dates around christmas (ie. 24/12/##, 25/12/##, and 26/12/##). The dates start in column A row 3.

Does anyone out there now now to do this quickly via a macro of some sort, as doing it manually would take about six months i reckon!

Thanks very much.

Hello fergmscg,

Welcome to the Forum!

This macro will open each workbook with an xlsx extension in the folder you specify. it will check the only the worksheets whose name start with "Stock". Any date that is from 12/24 to 12/26 will have its row deleted.

Because this could take some time to complete, the macro turns on Excel's status bar and display the workbook and worksheet it is currently checking. Each workbook is saved once the changes, if any, are made. The macro will continue until there are no more workbooks to open.

Change the folder (marked in bold) to the directory you will be using. Copy and paste this code into a new VBA module in your Workbook's VBA project. Remember macros must be enabled before the code will run.

' Thread:  http://www.excelforum.com/excel-programming/793072-need-to-delete-all-rows-containing-christmas.html
' Poster:  fergmcg
' Written: Septemeber 20, 2011
' Author:  Leith Ross

Sub DeleteChristmasRows()

  Dim Dates As Variant
  Dim FileName As String
  Dim FolderPath As String
  Dim i As Long
  Dim iDates As Variant
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  Dim Wkb As Workbook
  
    ' Directory with workbooks to checked
      FolderPath = "C:\Documents and Settings\Admin.ADMINS\My Documents"
      
      Application.DisplayStatusBar = True
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      
        ' Add a backslash to the folder path if it is missing.
          FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath, "\", FolderPath)
          
        ' Find the first workbook in the folder.
          FileName = Dir(FolderPath, "*.xlsx")
          
          Do While FileName <> ""
          
            ' Open each workbook in the specified folder.
              Set Wkb = Workbooks.Open(FileName:=FilePath & FileName)
              
                  For Each Wks In Wkb
                  
                  ' Look only at worksheets whose names start with Stock.
                    If LCase(Wks.Name) Like "stock*" Then
                    
                     ' Update the StatusBar
                       Application.StatusBar = "Checking Workbook: " & Wkb.Name & "  Current Sheet: " & Wks.Name
                       
                       Set Rng = Wks.Range("A3")
                       Set RngEnd = Wks.Cells(Rows.Count, "A").End(xlUp)
                       If RngEnd.Row < Rng.Row Then Exit For Else Dates = Wks.Range(Rng, RngEnd).Value
                           
                         ' Check the dates.
                           For i = UBound(Dates) To 1 Step -1
                             iDate = Dates(i, 1)
                             
                           ' Delete the row if the month is December and the day is between from 24 to 26.
                             If Month(iDate) = 12 Then
                                If Day(iDate) >= 24 And Day(iDate) <= 26 Then
                                 ' Change the date index number to its worksheet row number.
                                   Wks.Rows(i + 3 - 1).EntireRow.Delete Shift:=xlShiftUp
                                End If
                             End If
                             
                           Next i
                           
                    End If
                    
                  Next Wks
                  
              Wkb.Close SaveChanges:=True
              FileName = Dir()
          Loop
          
      Application.DisplayStatusBar = False
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic
      
End Sub

Hello fergmcg,

Sorry about that. I should have checked my typing. The line should be...

    FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath & "\", FolderPath)

Hello fergmcg,

I have checked the macro for any other typos and it should be good to go. The last problem was the comma should have been an ampersand. You can't concatenate the file extension with a comma.

Sub DeleteChristmasRows()

  Dim Dates As Variant
  Dim FileName As String
  Dim FolderPath As String
  Dim i As Long
  Dim iDates As Variant
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  Dim Wkb As Workbook
  
    ' Directory with workbooks to checked
      FolderPath = "C:\Users\Fergus\Dropbox\latest work\IPO carve out and demerger\data\company data"
      
      Application.DisplayStatusBar = True
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      
          
        ' Add a backslash to the folder path if it is missing.
          FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath & "\", FolderPath)
                  
        ' Find the first workbook in the folder.
          FileName = Dir(FolderPath & "*.xlsm")
          
          Do While FileName <> ""
          
            ' Open each workbook in the specified folder.
              Set Wkb = Workbooks.Open(FileName:=FilePath & FileName)
              
                  For Each Wks In Wkb
                  
                  ' Look only at worksheets whose names start with Stock.
                    If LCase(Wks.Name) Like "stock*" Then
                    
                     ' Update the StatusBar
                       Application.StatusBar = "Checking Workbook: " & Wkb.Name & "  Current Sheet: " & Wks.Name
                       
                       Set Rng = Wks.Range("A3")
                       Set RngEnd = Wks.Cells(Rows.Count, "A").End(xlUp)
                       If RngEnd.Row < Rng.Row Then Exit For Else Dates = Wks.Range(Rng, RngEnd).Value
                           
                         ' Check the dates.
                           For i = UBound(Dates) To 1 Step -1
                             iDate = Dates(i, 1)
                             
                           ' Delete the row if the month is December and the day is between from 24 to 26.
                             If Month(iDate) = 12 Then
                                If Day(iDate) >= 24 And Day(iDate) <= 26 Then
                                 ' Change the date index number to its worksheet row number.
                                   Wks.Rows(i + 3 - 1).EntireRow.Delete Shift:=xlShiftUp
                                End If
                             End If
                             
                           Next i
                           
                    End If
                    
                  Next Wks
                  
              Wkb.Close SaveChanges:=True
              FileName = Dir()
          Loop
          
      Application.DisplayStatusBar = False
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic

End Sub

As for the rugby match, my comment is "Alba gu bràth!"

Also for the true rugger don't forget these essentials bum wash and willy wash