Old macro cannot change first row headings

G

ggpowell2

New Member
Joined
Jan 5, 2018
Messages
1
I am not very knowledgeable about macros but the company I have just started working for has a few it uses to make reports out of the system more useable quickly. However, there is one that is broken and seems far too complex for me to fix so I am trying to copy another macro to at least generate the minimum we need. This macro takes files in one folder, merges them and separates them into different tabs based on the company, leaving the originally merged data in one 'raw data' tab for reference. It is doing most of this correctly, however, despite changing the folder it takes the files from and the files it is now using having a different first row to the previous ones it was used for (but all the same as each other) it is still generating each tab with the old headings in the first row. On the raw data tab the second row is coming out as the first row of each of the new files but individually it is lost and the old headings are there. In the macro these headings are not explicitly mentioned so I do not know where it is getting them from-please can someone help me by pointing out which part of code affects the first row/headings?

The macro I am using:

Code: 
Sub BigMacro()
 Call MergeAllWorkbooks
 Call filenamedelete
 Call peace
 Call formatting
 Call Extract_Data_XW
 Call Extract_Data_BC
 Call Extract_Data_GE
 Call Extract_Data_YN
 Call Extract_Data_EB
 Call Extract_Data_ST
 Call Extract_Data_NK
 Call Extract_Data_LQ
 Call Extract_Data_KZ_EC
 Call Extract_Data_MU
 Call Extract_Data_EV
 Call Extract_Data_ZP
 Call Extract_Data_DZ
 Call Extract_Data_ZY
 Call Extract_Data_NX
 Call Extract_Data_AZ
 Call Extract_Data_ZJ
 Call Extract_Data_QL
 Call Extract_Data_WY
 Call Extract_Data_YT
 Call Extract_Data_LP
 Call Extract_Data_CS
 Call Extract_Data_KL
 Call Extract_Data_MG
 Call Extract_Data_PQ
 Call Extract_Data_ZT
 Call Extract_Data_GE605
 Call Extract_Data_GE400
 End Sub

 'Description: Combines all files in a folder to a master file.
 Sub MergeAllWorkbooks()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    ' Change this to the path\folder location of your files.
    MyPath = "Z:\Shared Local\ASH-SVR25\KHS - Ashford\Network Management\Roadworks\Kent Lane Rental Scheme\GASLO\FPNs\Data"
    ' Add a slash at the end of the path if needed.
    If Right(MyPath, 1) <> "" Then
        MyPath = MyPath & ""
    End If
    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xl*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If
    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop
    ' Set various application properties.
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    ' Add a new workbook with one sheet.
    Set BaseWks = ActiveWorkbook.Sheets(1)
    rnum = 1
    ' Loop through all files in the myFiles array.
    If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum), , , , , , , , , , , , , , xlRepairFile)
            Call Insertarea(mybook)
            On Error GoTo 0
            If Not mybook Is Nothing Then
                On Error Resume Next
                ' Change this range to fit your own needs.
                With mybook.Worksheets(1)
                    Set sourceRange = .Range("A1:AS5000")
                End With
                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                Else
                    ' If source range uses all columns then
                    ' skip this file.
                    If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                        Set sourceRange = Nothing
                    End If
                End If
                On Error GoTo 0
                If Not sourceRange Is Nothing Then
                    SourceRcount = sourceRange.Rows.Count
                    If rnum + SourceRcount >= BaseWks.Rows.Count Then
                        MsgBox "There are not enough rows in the target worksheet."
                        BaseWks.Columns.AutoFit
                        mybook.Close savechanges:=False
                        GoTo ExitTheSub
                    Else
                        ' Copy the file name in column A.
                        With sourceRange
                            BaseWks.Cells(rnum, "A"). _
                                    Resize(.Rows.Count).Value = MyFiles(FNum)
                        End With
                        ' Set the destination range.
                        Set destrange = BaseWks.Range("B" & rnum)
                        ' Copy the values from the source range
                        ' to the destination range.
                        With sourceRange
                            Set destrange = destrange. _
                                            Resize(.Rows.Count, .Columns.Count)
                        End With
                        destrange.Value = sourceRange.Value
                        rnum = rnum + SourceRcount
                    End If
                End If
                mybook.Close savechanges:=False
            End If
        Next FNum
        BaseWks.Columns.AutoFit
    End If
 ExitTheSub:
    ' Restore the application properties.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
 End Sub
 Sub filenamedelete()
 Columns("A:A").Delete shift:=xlToLeft
 End Sub
 Sub DeleteBlanks()
 Dim x As Integer, LstCol As Integer, LstRow As Integer
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 LstCol = Cells(2, Columns.Count).End(xlToLeft).Column
 For x = LstCol To 1 Step -1
    LstRow = Cells(Rows.Count, x).End(xlUp).Row
    If LstRow = 1 Or x = 11 Or x = 14 Or x = 15 Or x = 16 Then
        Cells(1, x).EntireColumn.Delete shift:=xlToLeft
    End If
 Next x
    Range("A1").Select

 End Sub
 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 If SaveAsUI = False Then
    Cancel = True
    MsgBox "You cannot save this workbook.  Use Save As"
 End If
 End Sub
 Sub Extract_Data_DZ()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=DZ*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "SESW"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_ZY()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=ZY*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "ESP(BGASC)"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_NX()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=NX*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Voda"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub

 Sub Extract_Data_BC()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=BC*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "BT"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("j1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_GE()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=GE*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Kent"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_l As Long
 end_row_l = Range("l60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_l + 2).Formula = "= SUM(l2:l" & end_row_l & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_XW()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=XW*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "SGN"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_l As Long
 end_row_l = Range("l60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_l + 2).Formula = "= SUM(l2:l" & end_row_l & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_YN()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=YN*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "T Mobile"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_EB()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=EB*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "SEW"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_l As Long
 end_row_l = Range("l60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_l + 2).Formula = "= SUM(l2:l" & end_row_l & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_ZP()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=ZP*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "GTC"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_EV()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=EV*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Affinity Water"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_MU()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=MU*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Thames"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_l As Long
 end_row_l = Range("l60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_l + 2).Formula = "= SUM(l2:l" & end_row_l & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_KZ_EC()
 Application.ScreenUpdating = False
 Dim FilterCriteria1
 Dim FilterCriteria2
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria1 = "=KZ*"
 FilterCriteria2 = "=EC*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria1, Operator:=xlOr, _
        Criteria2:=FilterCriteria2
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "UKPN"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub

 Sub Extract_Data_LQ()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=LQ*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "SWS"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_l As Long
 end_row_l = Range("l60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_l + 2).Formula = "= SUM(l2:l" & end_row_l & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub

 Sub Extract_Data_NK()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=NK*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Virgin"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_ST()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=ST*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "IPipe"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub formatting()
 Range("A1").Select
    If Cells(1, 1).Value <> "" Then
        Cells(1, 1).EntireRow.Insert
    End If
    ActiveCell.FormulaR1C1 = "Area"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Mayrise reference"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Permit Reference"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Phase start"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Phase finish"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "USRN"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "District"
    Range("H1").Value = "Works description"
    Range("I1").Value = "Location"
    Range("J1").Value = "Works Catagory"
    Range("K1").Value = "Promotors Charge"
    Range("L1").Value = "Cost"
    Range("M1").Value = "Comments"

    Range("A1:AS1").Font.Bold = True
    Range("A1:AS1").Font.Name = "Georgia"
    Range("A1:AS1").Font.Size = 10
    Range("A1:AS1").Font.ColorIndex = xlAutomatic
    Range("A1:AS1").HorizontalAlignment = xlLeft
    Columns("B:B").NumberFormat = "00000000"
    Columns("D:D").NumberFormat = "dd/mmm/yyyy"
    Columns("L:L").NumberFormat = "$#,##0.00"
    ActiveSheet.UsedRange.EntireColumn.AutoFit
 End Sub

 'sort out formatting of columns, and sum column, and Headings.


 Sub Extract_Data_AZ()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=AZ*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "BGT"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_ZJ()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=ZJ*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "KPNMCNIC"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_QL()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=QL*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "C+W"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_WY()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=WY*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Fulcrum"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_YT()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=YT*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Vtesse"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_RT()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=RT*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Global"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_LP()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=LP*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Southern"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_CS()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=CS*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Colt"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_KL()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=KL*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "NetR"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_MG()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=MG*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "O2"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_PQ()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=PQ*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Verison"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_ZT()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=ZT*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Other"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_GE605()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=GE605*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Bouygues"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_j As Long
 end_row_j = Range("j60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_j + 2).Formula = "= SUM(l2:l" & end_row_j & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Extract_Data_GE400()
 Application.ScreenUpdating = False
 Dim FilterCriteria
 Dim CurrentsheetName As String
 Dim NewFileName As String
 CurrentsheetName = ActiveSheet.Name
 Range("A1:AS3000").Select
 Selection.AutoFilter
 FilterCriteria = "=GE400*"
 Selection.AutoFilter field:=3, Criteria1:=FilterCriteria
 Selection.SpecialCells(xlCellTypeVisible).Select
 Selection.Copy
 Sheets.Add
 ActiveSheet.Name = "Amey"
 Range("A1").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 Dim end_row_l As Long
 end_row_l = Range("l60000").End(xlUp).Row
 'ActiveSheet.Range("j" & end_row_j + 2).Formula = "= SUM(j2:j" & end_row_j & ")"
 ActiveSheet.Range("l" & end_row_l + 2).Formula = "= SUM(l2:l" & end_row_l & ")"
 ActiveSheet.Range("L1").EntireRow.NumberFormat = "$#,##0.00"
 ActiveSheet.Range("J1").EntireRow.NumberFormat = "dd/mm/yyyy"
 Cells.Select
 Selection.Columns.AutoFit
 Range("A1").Select
 Worksheets(CurrentsheetName).Activate
 Selection.AutoFilter field:=1
 Selection.AutoFilter
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub
 Sub Insertarea(Ws As Workbook)
 Dim W As Worksheet
 Dim x As Integer, LstRow As Integer, y As Integer
 Dim area As String
 Dim FullNm As String
 Set W = Ws.Worksheets(1)
 'If W.Cells(2, 1).Value = "" Then Exit Sub
 FullNm = Ws.Name
 For x = 1 To 3
    Select Case x
        Case 1
            area = "KCC North West Team"
        Case 2
            area = "KCC West Central Team"
        Case 3
            area = "KCC South East Team"


    End Select
    If InStr(1, FullNm, area, 1) > 0 Then
        LstRow = W.Cells(W.Rows.Count, 1).End(xlUp).Row
        W.Cells(1, 1).EntireColumn.Insert
        For y = 1 To LstRow
            If W.Cells(y, 4).Value <> "" And W.Cells(y, 2).Value = "" Then
                If W.Cells(y, 15).Value = "beer" Then
                    W.Cells(y, 2).Value = "beer"
                Else
                    W.Cells(y, 2).Value = "beer"
                End If
            End If
            If Left(W.Cells(y, 2).Value, 5) = "Grant" Then
                W.Cells(y, 1).Value = area
            End If
        Next y
        Ws.Cells(1, 13).EntireColumn.Delete xlToLeft
        Ws.Cells(1, 5).EntireColumn.Delete xlToLeft
        Ws.Cells(1, 3).EntireColumn.Delete xlToLeft

        Exit Sub
    End If
 Next x
 'MsgBox ("Check Naming of Spreadsheet. Could not find Area Name within " & FullNm) *** Temp disabled, Sam ***
 End Sub
 Sub peace()
 Dim x As Integer, LstCol As Integer, LstRow As Integer
   Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 LstCol = Cells(2, Columns.Count).End(xlToLeft).Column
 For x = LstCol To 1 Step -1
    LstRow = Cells(Rows.Count, x).End(xlUp).Row
    If LstRow = 1 Or x = 11 Or x = 14 Or x = 15 Or x = 16 Then
    End If
 Next x
    Range("A1").Select

 End Sub
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
You must log in or register to reply here.

Similar threads

C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
225
Coco1
C
O
  • Solved
VBA: Deleting Visible rows using Auto Filter; Excluding Header
Replies
4
Views
399
mumps
mumps
N
  • Question
My code is suddenly really slow
Replies
1
Views
142
RobP
R
S
  • Question
Worksheet Change Event
Replies
2
Views
385
sspatriots
S
H
  • Solved
VBA for SUM and COUNTA
Replies
2
Views
430
Holley
H

Forum statistics

Threads
1,215,106
Messages
6,123,122
Members
449,096
Latest member
provoking

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top