Attribute VB_Name = "DESC_reformer"
Sub DESCassetcleaner()
Attribute DESCassetcleaner.VB_Description = "reformatting DESC assets for upload (font etc)"
Attribute DESCassetcleaner.VB_ProcData.VB_Invoke_Func = "K\n14"
'
' Macro2 Macro
' reformatting DESC assets for upload (font etc)
'
' Keyboard Shortcut: Ctrl+Shift+K

    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog

    Dim WS_Count As Integer
    Dim i As Integer
    Dim lastrow As Long
    
    
    
    Application.ScreenUpdating = False   'turn off screen updates for better processing speed etc
    Application.EnableEvents = False
    
    
    'Retrieve Target Folder Path From User
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

    'In Case of Cancel
NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings

    'Target File Extension (must include wildcard "*")
    myExtension = "*.xls*"

    'Target Path with Ending Extention
    myFile = Dir(myPath & myExtension)

    'Loop through each Excel file in folder
    Do While myFile <> ""
    
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(FileName:=myPath & myFile)
      WS_Count = ActiveWorkbook.Worksheets.Count  ' Set WS_Count equal to the number of worksheets in the active workbook.
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
            ' MAIN DESC MACRO STARTS HERE
                With Worksheets   'make all worksheets have a standard zoom scale
                    .Select
                    ActiveWindow.Zoom = 100
                End With
                 
                For i = 1 To WS_Count  ' Begin the loop for each worksheet in the workbook
                
                Sheets(i).Select
                
                With ActiveWindow   'eliminate any split windows
                    .SplitColumn = 0
                    .SplitRow = 0
                End With
                
                ActiveWindow.FreezePanes = False   'unfreeze top row if necessary
                    
                Cells.Select
                
                With Selection.Font
                    .Name = "Arial"
                    .Size = 10
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .ThemeFont = xlThemeFontNone
                End With
                
                With Selection.Interior    'remove any and all cell coloring
                    .Pattern = xlNone
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
                
               Cells.Select    'get rid of any remaining classifications in brackets
                Selection.Replace What:=" [*]", Replacement:="", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
                    
                Cells.Select
                Cells.EntireColumn.AutoFit  'make columns pretty
                Cells.EntireRow.AutoFit    'standardize row heights
                
                
                With WorksheetFunction
                   If .CountA(ActiveSheet.Cells) = .CountA(ActiveSheet.Rows(1)) Then
                       Range("A2").Formula = "No data."
                   End If
                End With
            
                Range("A1").Select  'put cursor in the "normal" cell
                
                'duplicate row detection:
                
                lastrow = Range("A" & Rows.Count).End(xlUp).Row
                Columns("A:A").Select
                Selection.Insert Shift:=xlToRight
                Range("A1").Select
                ActiveCell.FormulaR1C1 = "dupes"
                Range("A2").Select
                ActiveCell.FormulaR1C1 = "=IF(AND(RC[1]=R[-1]C[1],RC[2]=R[-1]C[2],RC[3]=R[-1]C[3]),""DUPE"","""")"
                
               'ActiveCell.FormulaR1C1 = _   'this is for the exploded-style of DESC export
                    '"=IF(AND(RC[2]=R[-1]C[2],RC[3]=R[-1]C[3],RC[4]=R[-1]C[4],RC[5]=R[-1]C[5],RC[6]=R[-1]C[6],RC[7]=R[-1]C[7],RC[8]=R[-1]C[8],RC[9]=R[-1]C[9],RC[10]=R[-1]C[10],RC[11]=R[-1]C[11]),""DUPE"","""")"
                
                
                Range("A2").Select
                If lastrow > 2 Then
                    Selection.AutoFill Destination:=Range("A2:A" & lastrow)   'can't do auto-fill method for single rows of data (edge case)
                End If
            
                Cells.Select
                Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
                    "=INDIRECT(""A""&ROW())=""DUPE"""
                Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
                With Selection.FormatConditions(1).Interior    'if a dupe row is detected, color the row light green
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent6
                    .TintAndShade = 0.599963377788629
                End With
                Selection.FormatConditions(1).StopIfTrue = True
                
                'look for duplicate rows; if none found, delete the dupes column
                
                With WorksheetFunction
                   If .CountIf(ActiveSheet.Columns(1), "DUPE") = 0 Then
                       Columns("A:A").Select
                       Selection.Delete Shift:=xlToLeft
                   End If
                End With
             
               
                Range("A1").Select  'put cursor in the "normal" cell
                Next i
                
                Sheets(1).Select
    
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop
  
  'Message Box when tasks are completed
  MsgBox "Reformatting Complete!"
  
ResetSettings:
  'Reset Macro Optimization Settings
    Application.ScreenUpdating = True   'turn on screen updates
    Application.EnableEvents = True
    
End Sub