Good afternoon. I'm in the final stages of building a workbook that will synthesize a huge amount of data from a CSV file into a usable format. I realize my code is not very elegant but I'm using the limited skills I have to attempt this time saving workbook.

After I call all of the macros in the workbook, I need one last macro to loop through all worksheets and delete specific rows based on the data contained in column D titled "Team" in each worksheet. For instance:

  • In Worksheet "Non-Billable", I need to delete all rows that have data in column D leaving only the rows that have no data in column D.
  • In Worksheet "Bangor", I need to delete all rows that have data in column D leaving only the rows that have "Bgr1", "BgrO" or "Mac" in column D.
  • In Worksheet "Dover-Foxcroft", I need to delete all rows that have data in column D leaving only the rows that have "Dov" or "DovO" in column D.
  • In Worksheet "Wilton", I need to delete all rows that have data in column D leaving only the rows that have "Far", "FarO" or "FarC" in column D.
  • In Worksheet "Presque Isle", I need to delete all rows that have data in column D leaving only the rows that have "Pqi" in column D.
  • In Worksheet "Waterville", I need to delete all rows that have data in column D leaving only the rows that have "WtvO" in column D.

I've attached the workbook and the code I'm using is pasted below.

Sub CreateCurrentOmit()
Call ChangeWorksheetName
Call DeleteColumns
Call MoveColumnI
Call HeadersandFormatting
Call SORT
Call FreezeTopRow
Call CopyWorksheet
Call RenameWorksheets

End Sub

Sub ChangeWorksheetName()

    ActiveSheet.Name = "Non-Billable"

End Sub

Sub DeleteColumns()

    Application.EnableEvents = False    '<---------Added line of Code to make "refresh" less choppy"
    Application.ScreenUpdating = False  '<---------Added line of Code to make "refresh" less choppy"
    
    Range("A:AH,AJ:AM,AO:AR,AT:AV,AZ:BA,BC:BC,BE:BK,BM:DL").Select
    Range("A1").Activate
    Selection.Delete shift:=xlToLeft

    Application.ScreenUpdating = True   '<---------Added line of Code to make "refresh" less choppy"
    Application.EnableEvents = True     '<---------Added line of Code to make "refresh" less choppy"

End Sub
Sub MoveColumnI()

    Application.EnableEvents = False    '<---------Added line of Code to make "refresh" less choppy"
    Application.ScreenUpdating = False  '<---------Added line of Code to make "refresh" less choppy"
    
    Columns("I:I").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert shift:=xlToRight
    
    Application.ScreenUpdating = True   '<---------Added line of Code to make "refresh" less choppy"
    Application.EnableEvents = True     '<---------Added line of Code to make "refresh" less choppy"
    
End Sub

Sub SORT()
    
    Dim oneRange As Range
    Dim aCell As Range

    Set oneRange = Range("A1:I2000")
    Set aCell = Range("D1")

    oneRange.SORT Key1:=aCell, Order1:=xlAscending, Header:=xlYes
    
End Sub

Sub HeadersandFormatting()
Dim wbI As Workbook
Dim wsI As Worksheet
Dim LR As Long

Set wbI = ThisWorkbook                          'Source/Input Workbook
Set wsI = wbI.Sheets("Non-Billable")       'Set the relevant sheet from where you want to copy

With wsI
    wsI.Range("A1").CurrentRegion.Copy .Range("A1")      'Paste it in say Cell A1. Change as applicable
    Rows(1).Insert shift:=xlShiftDown
    
    .Range("A1:J1").Value = [{"Worker","Client", "Scheduled as", "Team", "Date", "Time In", "Time Out", "Total Time", "Rate", "Comments"}]
    .Rows("1:1").Font.Bold = True                   'Bold top row
    
    .Range("C:J").HorizontalAlignment = xlCenter    'formatting
    .Columns("A:E").AutoFit
    .Columns("F").ColumnWidth = 15
    .Columns("G").ColumnWidth = 15
    .Columns("H").ColumnWidth = 10
    .Columns("I").ColumnWidth = 10
    .Columns("J").ColumnWidth = 60
    .Columns("A:J").Font.Color = vbBlack
    .Columns("A:J").Font.Size = 11
    .Columns("A:J").Font.Name = "Times New Roman"
   
   
End With

End Sub
Sub FreezeTopRow()

    Rows("1:1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Selection.Font.Bold = True
    Range("A1:H1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub


Sub CopyWorksheet()
   Dim x As Integer
   
   x = InputBox("Enter number of times to copy active sheet")
   For numtimes = 1 To x
      'Loop by using x as the index number to make x number copies.
      ActiveWorkbook.ActiveSheet.Copy _
         After:=ActiveWorkbook.Sheets("Non-Billable")
         'Put copies after.
         'Replace "Sheet1" with sheet name that you want.
   Next
End Sub

Sub RenameWorksheets()

    Sheets("Non-Billable (6)").Select
    Sheets("Non-Billable (6)").Name = "Bangor"
    
    Sheets("Non-Billable (5)").Select
    Sheets("Non-Billable (5)").Name = "Dover-Foxcroft"
    
    Sheets("Non-Billable (4)").Select
    Sheets("Non-Billable (4)").Name = "Presque Isle"
    
    Sheets("Non-Billable (3)").Select
    Sheets("Non-Billable (3)").Name = "Waterville"
    
    Sheets("Non-Billable (2)").Select
    Sheets("Non-Billable (2)").Name = "Wilton"

End Sub
Current Omit (template).xlsm

Thanks.

Matthew