'*********************************************************************
'************************ AirFreightRef ******************************
'*********************************************************************

'   name            = 'AirFreightRef'
'   version         = '2.0'
'   license         = Free for all
'   Summary         = "Cleans the mess for AirFreight"
'   Description     = "Script cleans formating and styles next copy
'                       all to new worksheet with the name AfCleanSheet.
'                       Remove unwanted columns and set up new formating"
'   author          = Jacek Jarecki
'   email           = 'awariat@gmail.com'
'   homepage        = 'yoolek.com'
'   tested on       = 'vba 7.1,excell 2013'

'*********************************************************************
'*********************************************************************
'*********************************************************************

Sub AirFreightRef()

'- Turn off screen updates to improve performance
Application.ScreenUpdating = False

'***********************************************************************************************************
'*******************************************************************************    STEP ONE: CLEAN THE MESS
'***********************************************************************************************************
'v2 improvment in this block
    
'copy content of worksheet 1
ActiveSheet.UsedRange.Select
Selection.Copy

'create new worksheet and paste content
Worksheets.Add().Name = "AF_CleanSheet"
Worksheets("AF_CleanSheet").Select
ActiveSheet.Paste

'Clear formatting in new worksheet
With ActiveSheet.Cells

    .ClearFormats
    .FormatConditions.Delete
    .Interior.ColorIndex = xlColorIndexNone
    .Interior.ColorIndex = xlNone
    .Font.Name = Application.StandardFont
    .Font.Size = Application.StandardFontSize
    .EntireColumn.AutoFit
    
End With

'Clear styles in new worksheet
ActiveSheet.ListObjects(1).TableStyle = ""
        

'***********************************************************************************************************
'********************************************************************************    STEP TWO: SET VARIABLES
'***********************************************************************************************************

Dim myColumns As Variant
Dim myStyles As Variant
Dim style As Variant
Dim x As Variant
Dim y As Variant
Dim findfield As Variant
Dim currentColumn As Integer
Dim columnHeading As String
Dim oCell As Range
Dim iNum As Long
Dim iRow As Integer
Dim column As Integer

'***********************************************************************************************************
'********************************************************************    STEP THREE: REMOVE UNWANTED COLUMNS
'***********************************************************************************************************

'- Create array of columns we like (using headers names)
myColumns = Array("dealer_pick_pack_code", "customer_code", "invoice_number", "invoice_order_type", "finis_code", "pieces_shipped", "part_description")
'<---YOU CAN EDIT but remember to change columns for sorting(step five)

'- apply styles to each column
myStyles = Array("style2", "style2", "style2", "style3", "style2", "style3", "style1")
'<---YOU CAN EDIT(look step five)

'- search our columns and move all to right
For x = LBound(myColumns) To UBound(myColumns) ' from the lowest index in array to the highest
    findfield = myColumns(x)
    iNum = iNum + 1
    Set oCell = ActiveSheet.rows(1).Find(What:=findfield, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not oCell.column = iNum Then
        Columns(oCell.column).Cut
        Columns(iNum).Insert Shift:=xlToRight
    End If
Next x

'- delete the rest unwanted columns
For currentColumn = ActiveSheet.UsedRange.Columns.Count To (UBound(myColumns) + 2) Step -1      'UsedRange - how many columns in use
        ActiveSheet.Columns(currentColumn).Delete
Next currentColumn

'***********************************************************************************************************
'*******************************************************************    STEP FOUR: ONLY AIR FREIGHT REFERALS
'***********************************************************************************************************

'remove all rows other than referals af
Dim intRow
Dim intLastRow
intLastRow = Range("A65536").End(xlUp).Row

For intRow = intLastRow To 2 Step -1

    rows(intRow).Select
    If Cells(intRow, 1).value > 99999 Or Cells(intRow, 1) = "" Or Cells(intRow, 1).value < 99000 Then
    Cells(intRow, 1).Select
    Selection.EntireRow.Delete
    End If

Next intRow
'Range("A1").Select

'***********************************************************************************************************
'************************************************************************************    STEP FIVE: SORT ALL
'***********************************************************************************************************

'- sort column "a" country code and "d" order type and...
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A9999"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveSheet.Sort.SortFields.Add Key:=Range("D2:D9999"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveSheet.Sort.SortFields.Add Key:=Range("E2:E9999"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveSheet.Sort

    .SetRange Range("A1:Z999")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    
End With

'***********************************************************************************************************
'***********************************************************************************    STEP SIX: SET STYLES
'***********************************************************************************************************

For y = LBound(myColumns) To UBound(myColumns) ' from the lowest index in array to the highest
    
    style = myStyles(y)
    column = y + 1
    Select Case style
        
            Case "style1"
             
                Columns(column).HorizontalAlignment = xlHAlignLeft
                Columns(column).ColumnWidth = 30
               
            Case "style2"
            
                Columns(column).HorizontalAlignment = xlHAlignCenter
                Columns(column).ColumnWidth = 10
               
            Case "style3"
            
                Columns(column).HorizontalAlignment = xlHAlignRight
                Columns(column).ColumnWidth = 4
               
            Case Else
            
               ' do nothing
               
       End Select

Next y

'***********************************************************************************************************
'***********************************************************************************    STEP SEVEN: DIVIDER
'***********************************************************************************************************


Range("a1").Select
iRow = 1

Do

    If Cells(iRow + 1, 1) <> Cells(iRow, 1) Then
    
        'insert row'
        Cells(iRow + 1, 1).EntireRow.Insert Shift:=xlDown
        'set the height of row
        Cells(iRow + 1, 1).Range("A1").RowHeight = 4
        
        
        'create background colour in all columns (using loop)'
        Dim index As Integer
        index = 1
        
        Do While index <= UBound(myColumns) + 1
        
            Cells(iRow + 1, index).Interior.ColorIndex = 15
            index = index + 1
        
        Loop
                               
        iRow = iRow + 2
        
    Else
    
        iRow = iRow + 1
        
    End If

Loop While Not Cells(iRow, 1).Text = ""

'***********************************************************************************************************
'***********************************************************************************    END
'***********************************************************************************************************

'- Restore screen updates to display changes
Application.ScreenUpdating = True

End Sub