Return to Answer

The posted Subroutine a_organizar_protocolo is composed of 249 lines. This is too many lines for most procedures (especially if they are fulfilling a single responsibility). In terms of responsibility, subroutine a_organizar_protocolo has the following responsibilities:

My suspicion is that `On Error Resume Next' was added to guarantee that the Application flags are reset. In the example above, it is now clear that the response to an error is to print an error message to the Immediate Window and reset the Application flags. And, only a single error effectively cancels the operation.

Usually refactoring using the DRY priniciple results in fewer lines of code. That is not really the case here. What the code above does accomplish is removal of all the repeated lines containing the repeated expression Columns("X:X").ColumnWidth = ##. And, in the future, when column "S" is added, only "S:XXXX:##" needs to be added to the columnFormatDefinitions string. Also, if Columns("Q:R") is a typo, this kind of error is more easily found.

This same approach can be used to eliminate all uses of Union - which may result is some efficiency improvements.

The posted Subroutine a_organizar_protocolo is composed of 249 lines. This is too many lines for most procedures (especially if they are fulfilling a single responsibility). Subroutine a_organizar_protocolo has the following responsibilities:

My suspicion is that `On Error Resume Next' was added to guarantee that the Application flags reset lines are executed. In the example above, it is now clear that the response to an error is to print an error message to the Immediate Window and reset the Application flags. And, a single error cancels the operation.

Usually refactoring using the DRY priniciple results in fewer lines of code. That is not really the case here. What the refactored code does accomplish is the removal of all the repeated lines containing the expression Columns("X:X").ColumnWidth = ##. And, in the future, when column "S" is added, only "S:XXXX:##" needs to be added to the columnFormatDefinitions string. Also, if Columns("Q:R") is a typo, this kind of error is more easily found.

This same approach can be used to eliminate all uses of Union which may result is some efficiency improvements.

'Best Practice: Always declare Option Explicit at the top of your modules.
'Doing so requires all variable/fields to be declared before they are used
'or the code does not compile
Option Explicit
Sub a_organizar_protocolo()
 Application.DisplayFormulaBar = False
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
 Application.Interactive = False
 
On Error GoTo ErrorExit
 ActiveWorkbook.Save
 ActiveSheet.AutoFilterMode = False
 ActiveWindow.Zoom = 90
 Columns("O:P").ClearContents
 Columns("R:R").ClearContents
 FormatContent
 
 UpdateValues
 
 Cells.Validation.Delete
 Cells.FormatConditions.Delete
 Range("E2").End(xlDown).Select
ResetFlags: 
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True
 Application.Interactive = True
 Exit Sub
ErrorExit:
 Debug.Print "Error: " & Err.Description
 Goto ResetFlags
End Sub
Private Sub FormatContent()
 With Cells
 .VerticalAlignment = xlCenter
 .HorizontalAlignment = xlCenter
 .Borders(xlDiagonalDown).LineStyle = xlNone
 .Borders(xlDiagonalUp).LineStyle = xlNone
 .WrapText = False
 .Orientation = 0
 .AddIndent = False
 .IndentLevel = 0
 .ShrinkToFit = False
 .ReadingOrder = xlContext
 .MergeCells = False
 With .Borders
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .Weight = xlThin
 End With
 With .Font
 .Name = "Calibri"
 .Size = 11
 .ColorIndex = xlAutomatic
 .Bold = False
 .Italic = False
 End With
 End With
 With Rows("1:1")
 .RowHeight = 32
 .Interior.ColorIndex = 49
 .WrapText = True
 With .Font
 .Size = 12
 .Bold = True
 .ColorIndex = 44
 End With
 End With
 With ActiveWindow
 .FreezePanes = False
 .SplitColumn = 0
 .SplitRow = 1
 .FreezePanes = True
 End With
 With Rows("2:" & Rows.Count)
 .RowHeight = 15
 .Interior.Color = xlNone
 End With
 
 FormatHeaders
 
 ApplyHorizontalAlignment "G", "J", "Q"
End Sub
Private Sub FormatHeaders()
 'Create a set of delimited format strings of the form <columnLetter:columnName:columnWidth>
 Dim columnFormatDefinitions As String
 columnFormatDefinitions = _
 "A:Lançamento:15," & _
 "B:Data de Recebimento:14," & _
 "C:Solicitante:20," & _
 "D:Espécie do Documento:30," & _
 "E:Número da Nota Fiscal:14," & _
 "F:Código do Fornecedor:11," & _
 "G:Fornecedor:40," & _
 "H:Centro de Custo:14," & _
 "I:Vencimento:14," & _
 "J:Valor:16," & _
 "K:Descrição:20," & _
 "L:Pedido:10," & _
 "M:Item do Pedido:8," & _
 "N:Pagamento:12," & _
 "O:Validação:5," & _
 "P:Prioridade:14," & _
 "Q:Observação:25," & _
 "R:Concatenar:25"
 
 Dim colLetter As String
 Dim colWidth As Long
 Dim colHeader As String
 Dim formatDefinition As Variant
 
 Dim formatElements As Variant
 For Each formatDefinition In Split(columnFormatDefinitions, ",")
 
 formatElements = Split(formatDefinition, ":")
 colLetter = formatElements(0)
 colHeader = formatElements(1)
 colWidth = CLng(formatElements(2))
 
 Columns(colLetter & ":" & colLetter).ColumnWidth = colWidth
 Range(colLetter & "1").Value = colHeader
 Next
End Sub
Private Sub ApplyHorizontalAlignment(ParamArray colLtrs() As Variant)
 
 Dim rangeOfInterest As Range
 Dim cLtr As Variant
 For Each cLtr In colLtrs
 Set rangeOfInterest = Range(Range(cLtr & "2"), Range(cLtr & Rows.Count))
 rangeOfInterest.HorizontalAlignment = xlLeft
 Next
End Sub
Private Sub UpdateValues()
 ReplaceSomeCharacters "G", "K"
 'ReplaceSomeCharacters replaces the code below
' Dim ea, e1, e2 As Range
' Set e1 = Range(Range("G2"), Range("G2").End(xlDown))
' Set e2 = Range(Range("K2"), Range("K2").End(xlDown))
' Set ea = Union(e1, e2)
' With ea
' .Replace What:=".", Replacement:=""
' .Replace What:="/", Replacement:=""
' .Replace What:=":", Replacement:=""
' .Replace What:="–", Replacement:="-"
' End With
 
 Dim r0, ra As Range
 Set r0 = Range(Range("E2"), Range("E2").End(xlDown))
 For Each ra In r0
 If Len(ra.Value) > 9 Then ra.Value = Right(ra.Value, 9)
 Next
 r0.Replace What:="x", Replacement:="0"
 Dim ta, tb As Range
 Dim t1, t2, t3, t4 As Range
 
 Dim t0 As Long
 
 t0 = Range("E:E").SpecialCells(xlCellTypeLastCell).Row
 
 ClearNonNumerics t0, "E2:E", "F2:F", "H2:H", "L2:M"
 'ClearNonNumerics replaces the code below
' Set t1 = Range("E2:E" & t0)
' Set t2 = Range("F2:F" & t0)
' Set t3 = Range("H2:H" & t0)
' Set t4 = Range("L2:M" & t0)
' Set tb = Union(t1, t2, t3, t4)
'
' Dim tc As String
' Dim td As String
' Dim te As String
' Dim t As Long
'
' For Each ta In tb
' tc = ""
' For t = 1 To Len(ta.Value)
' td = Mid(ta.Value, t, 1)
' If td Like "[0-9]" Then
' te = td
' Else
' te = ""
' End If
' tc = tc & te
' Next t
' ta.Value = tc
' Next
 Dim ya, yb As Range
 Set yb = Range(Range("J2"), Range("J2").End(xlDown))
 
 Dim yc As String
 Dim yd As String
 Dim ye As String
 Dim y As Long
 
 For Each ya In yb
 yc = ""
 For y = 1 To Len(ya.Value)
 yd = Mid(ya.Value, y, 1)
 If yd Like "[0-9],-" Then
 ye = yd
 Else
 ye = ""
 End If
 yc = yc & ye
 Next y
 ya.Value = yc * 1
 Next
 Dim ia, ib As Range
 Set ib = Range(Range("J2"), Range("J2").End(xlDown))
 For Each ia In ib
 If ia.Value < 0 Then
 With ia
 .Offset(0, -1).Value = "31/12/" & (Year(Date) + 1)
 .Offset(0, -2).Value = "NA"
 .Offset(0, 2).Value = "NA"
 .Offset(0, 3).Value = "NA"
 End With
 End If
 Next
 Dim oa, ob As Range
 Set ob = Range(Range("D2"), Range("D2").End(xlDown))
 For Each oa In ob
 If oa.Value = "Ouvidoria" Then
 With oa
 .Offset(0, -1).Value = oa.Value
 .Offset(0, 8).Value = "NA"
 .Offset(0, 9).Value = "NA"
 .Offset(0, 10).Value = "DEPÓSITO"
 End With
 End If
 Next
 Dim pa, pb, p1, p2 As Range
 Set p1 = Columns("H:H").SpecialCells(xlCellTypeBlanks)
 For Each pa In p1
 pa.Value = "Estoque"
 Next
 Set p2 = Range(Range("H2"), Range("H2").End(xlDown))
 For Each pb In p2
 If pb.Value = "Estoque" Then pb.Offset(0, -7).Value = pb.Value
 Next
 Dim k1, k2, k3, k4, k5, ka, kb, kaa, kbb As Range
 Set k1 = Range(Range("A2"), Range("A2").End(xlDown))
 Set k2 = Range(Range("C2"), Range("C2").End(xlDown))
 Set k3 = Range(Range("G2"), Range("G2").End(xlDown))
 Set k4 = Range(Range("K2"), Range("K2").End(xlDown))
 Set k5 = Range(Range("N2"), Range("N2").End(xlDown))
 Set ka = Union(k1, k2)
 Set kb = Union(k3, k4, k5)
 
 For Each kaa In ka
 kaa.Value = StrConv(kaa.Value, vbProperCase)
 Next kaa
 For Each kbb In kb
 kbb.Value = UCase(kbb.Value)
 Next kbb
End Sub
Private Sub ReplaceSomeCharacters (ParamArray colLtrs() As Variant)
 
 Dim rangeOfInterest As Range
 Dim cLtr As Variant
 For Each cLtr In colLtrs
 Set rangeOfInterest = Range(Range(cLtr & "2"), Range(cLtr & "2").End(xlDown))
 With rangeOfInterest
 .Replace What:=".", Replacement:=""
 .Replace What:="/", Replacement:=""
 .Replace What:=":", Replacement:=""
 .Replace What:="–", Replacement:="-"
 End With
 Next
End Sub
Private Sub ClearNonNumerics(ByVal eRow As Long, ParamArray rangeExpressions() As Variant)
 Dim tc As String
 Dim td As String
 Dim te As String
 Dim t As Long
 Dim rangeOfInterest As Range
 Dim rangeExpression As Variant
 For Each rangeExpression In rangeExpressions
 Set rangeOfInterest = Range(rangeExpression & eRow)
 tc = ""
 For t = 1 To Len(rangeOfInterest.Value)
 td = Mid(rangeOfInterest.Value, t, 1)
 If td Like "[0-9]" Then
 te = td
 Else
 te = ""
 End If
 tc = tc & te
 Next t
 
 rangeOfInterest .Value = tc
 Next
End Sub

'Best Practice: Always declare Option Explicit at the top of your modules.
'Doing so requires all variable/fields to be declared before they are used
'or the code does not compile
Option Explicit
Sub a_organizar_protocolo()
 Application.DisplayFormulaBar = False
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
 Application.Interactive = False
 
On Error GoTo ErrorExit
 ActiveWorkbook.Save
 ActiveSheet.AutoFilterMode = False
 ActiveWindow.Zoom = 90
 Columns("O:P").ClearContents
 Columns("R:R").ClearContents
 FormatContent
 
 UpdateValues
 
 Cells.Validation.Delete
 Cells.FormatConditions.Delete
 Range("E2").End(xlDown).Select
ResetFlags: 
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True
 Application.Interactive = True
 Exit Sub
ErrorExit:
 Debug.Print "Error: " & Err.Description
 Goto ResetFlags
End Sub
Private Sub FormatContent()
 With Cells
 .VerticalAlignment = xlCenter
 .HorizontalAlignment = xlCenter
 .Borders(xlDiagonalDown).LineStyle = xlNone
 .Borders(xlDiagonalUp).LineStyle = xlNone
 .WrapText = False
 .Orientation = 0
 .AddIndent = False
 .IndentLevel = 0
 .ShrinkToFit = False
 .ReadingOrder = xlContext
 .MergeCells = False
 With .Borders
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .Weight = xlThin
 End With
 With .Font
 .Name = "Calibri"
 .Size = 11
 .ColorIndex = xlAutomatic
 .Bold = False
 .Italic = False
 End With
 End With
 With Rows("1:1")
 .RowHeight = 32
 .Interior.ColorIndex = 49
 .WrapText = True
 With .Font
 .Size = 12
 .Bold = True
 .ColorIndex = 44
 End With
 End With
 With ActiveWindow
 .FreezePanes = False
 .SplitColumn = 0
 .SplitRow = 1
 .FreezePanes = True
 End With
 With Rows("2:" & Rows.Count)
 .RowHeight = 15
 .Interior.Color = xlNone
 End With
 
 FormatHeaders
 
 ApplyHorizontalAlignment "G", "J", "Q"
End Sub
Private Sub FormatHeaders()
 'Create a set of delimited format strings of the form <columnLetter:columnName:columnWidth>
 Dim columnFormatDefinitions As String
 columnFormatDefinitions = _
 "A:Lançamento:15," & _
 "B:Data de Recebimento:14," & _
 "C:Solicitante:20," & _
 "D:Espécie do Documento:30," & _
 "E:Número da Nota Fiscal:14," & _
 "F:Código do Fornecedor:11," & _
 "G:Fornecedor:40," & _
 "H:Centro de Custo:14," & _
 "I:Vencimento:14," & _
 "J:Valor:16," & _
 "K:Descrição:20," & _
 "L:Pedido:10," & _
 "M:Item do Pedido:8," & _
 "N:Pagamento:12," & _
 "O:Validação:5," & _
 "P:Prioridade:14," & _
 "Q:Observação:25," & _
 "R:Concatenar:25"
 
 Dim colLetter As String
 Dim colWidth As Long
 Dim colHeader As String
 Dim formatDefinition As Variant
 
 Dim formatElements As Variant
 For Each formatDefinition In Split(columnFormatDefinitions, ",")
 
 formatElements = Split(formatDefinition, ":")
 colLetter = formatElements(0)
 colHeader = formatElements(1)
 colWidth = CLng(formatElements(2))
 
 Columns(colLetter & ":" & colLetter).ColumnWidth = colWidth
 Range(colLetter & "1").Value = colHeader
 Next
End Sub
Private Sub ApplyHorizontalAlignment(ParamArray colLtrs() As Variant)
 
 Dim rangeOfInterest As Range
 Dim cLtr As Variant
 For Each cLtr In colLtrs
 Set rangeOfInterest = Range(Range(cLtr & "2"), Range(cLtr & Rows.Count))
 rangeOfInterest.HorizontalAlignment = xlLeft
 Next
End Sub
Private Sub UpdateValues()
 ReplaceSomeCharacters "G", "K"
 'ReplaceSomeCharacters replaces the code below
' Dim ea, e1, e2 As Range
' Set e1 = Range(Range("G2"), Range("G2").End(xlDown))
' Set e2 = Range(Range("K2"), Range("K2").End(xlDown))
' Set ea = Union(e1, e2)
' With ea
' .Replace What:=".", Replacement:=""
' .Replace What:="/", Replacement:=""
' .Replace What:=":", Replacement:=""
' .Replace What:="–", Replacement:="-"
' End With
 
 Dim r0, ra As Range
 Set r0 = Range(Range("E2"), Range("E2").End(xlDown))
 For Each ra In r0
 If Len(ra.Value) > 9 Then ra.Value = Right(ra.Value, 9)
 Next
 r0.Replace What:="x", Replacement:="0"
 Dim ta, tb As Range
 Dim t1, t2, t3, t4 As Range
 
 Dim t0 As Long
 
 t0 = Range("E:E").SpecialCells(xlCellTypeLastCell).Row
 
 ClearNonNumerics t0, "E2:E", "F2:F", "H2:H", "L2:M"
 'ClearNonNumerics replaces the code below
' Set t1 = Range("E2:E" & t0)
' Set t2 = Range("F2:F" & t0)
' Set t3 = Range("H2:H" & t0)
' Set t4 = Range("L2:M" & t0)
' Set tb = Union(t1, t2, t3, t4)
'
' Dim tc As String
' Dim td As String
' Dim te As String
' Dim t As Long
'
' For Each ta In tb
' tc = ""
' For t = 1 To Len(ta.Value)
' td = Mid(ta.Value, t, 1)
' If td Like "[0-9]" Then
' te = td
' Else
' te = ""
' End If
' tc = tc & te
' Next t
' ta.Value = tc
' Next
 Dim ya, yb As Range
 Set yb = Range(Range("J2"), Range("J2").End(xlDown))
 
 Dim yc As String
 Dim yd As String
 Dim ye As String
 Dim y As Long
 
 For Each ya In yb
 yc = ""
 For y = 1 To Len(ya.Value)
 yd = Mid(ya.Value, y, 1)
 If yd Like "[0-9],-" Then
 ye = yd
 Else
 ye = ""
 End If
 yc = yc & ye
 Next y
 ya.Value = yc * 1
 Next
 Dim ia, ib As Range
 Set ib = Range(Range("J2"), Range("J2").End(xlDown))
 For Each ia In ib
 If ia.Value < 0 Then
 With ia
 .Offset(0, -1).Value = "31/12/" & (Year(Date) + 1)
 .Offset(0, -2).Value = "NA"
 .Offset(0, 2).Value = "NA"
 .Offset(0, 3).Value = "NA"
 End With
 End If
 Next
 Dim oa, ob As Range
 Set ob = Range(Range("D2"), Range("D2").End(xlDown))
 For Each oa In ob
 If oa.Value = "Ouvidoria" Then
 With oa
 .Offset(0, -1).Value = oa.Value
 .Offset(0, 8).Value = "NA"
 .Offset(0, 9).Value = "NA"
 .Offset(0, 10).Value = "DEPÓSITO"
 End With
 End If
 Next
 Dim pa, pb, p1, p2 As Range
 Set p1 = Columns("H:H").SpecialCells(xlCellTypeBlanks)
 For Each pa In p1
 pa.Value = "Estoque"
 Next
 Set p2 = Range(Range("H2"), Range("H2").End(xlDown))
 For Each pb In p2
 If pb.Value = "Estoque" Then pb.Offset(0, -7).Value = pb.Value
 Next
 Dim k1, k2, k3, k4, k5, ka, kb, kaa, kbb As Range
 Set k1 = Range(Range("A2"), Range("A2").End(xlDown))
 Set k2 = Range(Range("C2"), Range("C2").End(xlDown))
 Set k3 = Range(Range("G2"), Range("G2").End(xlDown))
 Set k4 = Range(Range("K2"), Range("K2").End(xlDown))
 Set k5 = Range(Range("N2"), Range("N2").End(xlDown))
 Set ka = Union(k1, k2)
 Set kb = Union(k3, k4, k5)
 
 For Each kaa In ka
 kaa.Value = StrConv(kaa.Value, vbProperCase)
 Next kaa
 For Each kbb In kb
 kbb.Value = UCase(kbb.Value)
 Next kbb
End Sub
Private Sub ReplaceSomeCharacters (ParamArray colLtrs() As Variant)
 
 Dim rangeOfInterest As Range
 Dim cLtr As Variant
 For Each cLtr In colLtrs
 Set rangeOfInterest = Range(Range(cLtr & "2"), Range(cLtr & "2").End(xlDown))
 With rangeOfInterest
 .Replace What:=".", Replacement:=""
 .Replace What:="/", Replacement:=""
 .Replace What:=":", Replacement:=""
 .Replace What:="–", Replacement:="-"
 End With
 Next
End Sub
Private Sub ClearNonNumerics(ByVal eRow As Long, ParamArray rangeExpressions() As Variant)
 Dim tc As String
 Dim td As String
 Dim te As String
 Dim t As Long
 Dim rangeOfInterest As Range
 Dim rangeExpression As Variant
 For Each rangeExpression In rangeExpressions
 Set rangeOfInterest = Range(rangeExpression & eRow)
 tc = ""
 For t = 1 To Len(rangeOfInterest.Value)
 td = Mid(rangeOfInterest.Value, t, 1)
 If td Like "[0-9]" Then
 te = td
 Else
 te = ""
 End If
 tc = tc & te
 Next t
 
 rangeOfInterest .Value = tc
 Next
End Sub

'Best Practice: Always declare Option Explicit at the top of your modules.
'Doing so requires all variable/fields to be declared before they are used
'or the code does not compile
Option Explicit
Sub a_organizar_protocolo()
 Application.DisplayFormulaBar = False
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
 Application.Interactive = False
 
On Error GoTo ErrorExit
 ActiveWorkbook.Save
 ActiveSheet.AutoFilterMode = False
 ActiveWindow.Zoom = 90
 Columns("O:P").ClearContents
 Columns("R:R").ClearContents
 FormatContent
 
 UpdateValues
 
 Cells.Validation.Delete
 Cells.FormatConditions.Delete
 Range("E2").End(xlDown).Select
ErrorExit:
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True
 Application.Interactive = True
End Sub
Private Sub FormatContent()
 With Cells
 .VerticalAlignment = xlCenter
 .HorizontalAlignment = xlCenter
 .Borders(xlDiagonalDown).LineStyle = xlNone
 .Borders(xlDiagonalUp).LineStyle = xlNone
 .WrapText = False
 .Orientation = 0
 .AddIndent = False
 .IndentLevel = 0
 .ShrinkToFit = False
 .ReadingOrder = xlContext
 .MergeCells = False
 With .Borders
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .Weight = xlThin
 End With
 With .Font
 .Name = "Calibri"
 .Size = 11
 .ColorIndex = xlAutomatic
 .Bold = False
 .Italic = False
 End With
 End With
 With Rows("1:1")
 .RowHeight = 32
 .Interior.ColorIndex = 49
 .WrapText = True
 With .Font
 .Size = 12
 .Bold = True
 .ColorIndex = 44
 End With
 End With
 With ActiveWindow
 .FreezePanes = False
 .SplitColumn = 0
 .SplitRow = 1
 .FreezePanes = True
 End With
 With Rows("2:" & Rows.Count)
 .RowHeight = 15
 .Interior.Color = xlNone
 End With
 
 FormatHeaders
 
 ApplyHorizontalAlignment "G", "J", "Q"
End Sub
Private Sub FormatHeaders()
 'Create a set of delimited format strings of the form <columnLetter:columnName:columnWidth>
 Dim columnFormatDefinitions As String
 columnFormatDefinitions = _
 "A:Lançamento:15," & _
 "B:Data de Recebimento:14," & _
 "C:Solicitante:20," & _
 "D:Espécie do Documento:30," & _
 "E:Número da Nota Fiscal:14," & _
 "F:Código do Fornecedor:11," & _
 "G:Fornecedor:40," & _
 "H:Centro de Custo:14," & _
 "I:Vencimento:14," & _
 "J:Valor:16," & _
 "K:Descrição:20," & _
 "L:Pedido:10," & _
 "M:Item do Pedido:8," & _
 "N:Pagamento:12," & _
 "O:Validação:5," & _
 "P:Prioridade:14," & _
 "Q:Observação:25," & _
 "R:Concatenar:25"
 
 Dim colLetter As String
 Dim colWidth As Long
 Dim colHeader As String
 Dim formatDefinition As Variant
 
 Dim formatElements As Variant
 For Each formatDefinition In Split(columnFormatDefinitions, ",")
 
 formatElements = Split(formatDefinition, ":")
 colLetter = formatElements(0)
 colHeader = formatElements(1)
 colWidth = CLng(formatElements(2))
 
 Columns(colLetter & ":" & colLetter).ColumnWidth = colWidth
 Range(colLetter & "1").Value = colHeader
 Next
End Sub
Private Sub ApplyHorizontalAlignment(ParamArray colLtrs() As Variant)
 
 Dim rangeOfInterest As Range
 Dim cLtr As Variant
 For Each cLtr In colLtrs
 Set rangeOfInterest = Range(Range(cLtr & "2"), Range(cLtr & Rows.Count))
 rangeOfInterest.HorizontalAlignment = xlLeft
 Next
End Sub
Private Sub UpdateValues()
 ReplaceSomeCharacters "G", "K"
 'ReplaceSomeCharacters replaces the code below
' Dim ea, e1, e2 As Range
' Set e1 = Range(Range("G2"), Range("G2").End(xlDown))
' Set e2 = Range(Range("K2"), Range("K2").End(xlDown))
' Set ea = Union(e1, e2)
' With ea
' .Replace What:=".", Replacement:=""
' .Replace What:="/", Replacement:=""
' .Replace What:=":", Replacement:=""
' .Replace What:="–", Replacement:="-"
' End With
 
 Dim r0, ra As Range
 Set r0 = Range(Range("E2"), Range("E2").End(xlDown))
 For Each ra In r0
 If Len(ra.Value) > 9 Then ra.Value = Right(ra.Value, 9)
 Next
 r0.Replace What:="x", Replacement:="0"
 Dim ta, tb As Range
 Dim t1, t2, t3, t4 As Range
 
 Dim t0 As Long
 
 t0 = Range("E:E").SpecialCells(xlCellTypeLastCell).Row
 
 ClearNonNumerics t0, "E2:E", "F2:F", "H2:H", "L2:M"
 'ClearNonNumerics replaces the code below
' Set t1 = Range("E2:E" & t0)
' Set t2 = Range("F2:F" & t0)
' Set t3 = Range("H2:H" & t0)
' Set t4 = Range("L2:M" & t0)
' Set tb = Union(t1, t2, t3, t4)
'
' Dim tc As String
' Dim td As String
' Dim te As String
' Dim t As Long
'
' For Each ta In tb
' tc = ""
' For t = 1 To Len(ta.Value)
' td = Mid(ta.Value, t, 1)
' If td Like "[0-9]" Then
' te = td
' Else
' te = ""
' End If
' tc = tc & te
' Next t
' ta.Value = tc
' Next
 Dim ya, yb As Range
 Set yb = Range(Range("J2"), Range("J2").End(xlDown))
 
 Dim yc As String
 Dim yd As String
 Dim ye As String
 Dim y As Long
 
 For Each ya In yb
 yc = ""
 For y = 1 To Len(ya.Value)
 yd = Mid(ya.Value, y, 1)
 If yd Like "[0-9],-" Then
 ye = yd
 Else
 ye = ""
 End If
 yc = yc & ye
 Next y
 ya.Value = yc * 1
 Next
 Dim ia, ib As Range
 Set ib = Range(Range("J2"), Range("J2").End(xlDown))
 For Each ia In ib
 If ia.Value < 0 Then
 With ia
 .Offset(0, -1).Value = "31/12/" & (Year(Date) + 1)
 .Offset(0, -2).Value = "NA"
 .Offset(0, 2).Value = "NA"
 .Offset(0, 3).Value = "NA"
 End With
 End If
 Next
 Dim oa, ob As Range
 Set ob = Range(Range("D2"), Range("D2").End(xlDown))
 For Each oa In ob
 If oa.Value = "Ouvidoria" Then
 With oa
 .Offset(0, -1).Value = oa.Value
 .Offset(0, 8).Value = "NA"
 .Offset(0, 9).Value = "NA"
 .Offset(0, 10).Value = "DEPÓSITO"
 End With
 End If
 Next
 Dim pa, pb, p1, p2 As Range
 Set p1 = Columns("H:H").SpecialCells(xlCellTypeBlanks)
 For Each pa In p1
 pa.Value = "Estoque"
 Next
 Set p2 = Range(Range("H2"), Range("H2").End(xlDown))
 For Each pb In p2
 If pb.Value = "Estoque" Then pb.Offset(0, -7).Value = pb.Value
 Next
 Dim k1, k2, k3, k4, k5, ka, kb, kaa, kbb As Range
 Set k1 = Range(Range("A2"), Range("A2").End(xlDown))
 Set k2 = Range(Range("C2"), Range("C2").End(xlDown))
 Set k3 = Range(Range("G2"), Range("G2").End(xlDown))
 Set k4 = Range(Range("K2"), Range("K2").End(xlDown))
 Set k5 = Range(Range("N2"), Range("N2").End(xlDown))
 Set ka = Union(k1, k2)
 Set kb = Union(k3, k4, k5)
 
 For Each kaa In ka
 kaa.Value = StrConv(kaa.Value, vbProperCase)
 Next kaa
 For Each kbb In kb
 kbb.Value = UCase(kbb.Value)
 Next kbb
End Sub
Private Sub ReplaceSomeCharacters (ParamArray colLtrs() As Variant)
 
 Dim rangeOfInterest As Range
 Dim cLtr As Variant
 For Each cLtr In colLtrs
 Set rangeOfInterest = Range(Range(cLtr & "2"), Range(cLtr & "2").End(xlDown))
 With rangeOfInterest
 .Replace What:=".", Replacement:=""
 .Replace What:="/", Replacement:=""
 .Replace What:=":", Replacement:=""
 .Replace What:="–", Replacement:="-"
 End With
 Next
End Sub
Private Sub ClearNonNumerics(ByVal eRow As Long, ParamArray rangeExpressions() As Variant)
 Dim tc As String
 Dim td As String
 Dim te As String
 Dim t As Long
 Dim rangeOfInterest As Range
 Dim rangeExpression As Variant
 For Each rangeExpression In rangeExpressions
 Set rangeOfInterest = Range(rangeExpression & eRow)
 tc = ""
 For t = 1 To Len(rangeOfInterest .Value)
 td = Mid(rangeOfInterest .Value, t, 1)
 If td Like "[0-9]" Then
 te = td
 Else
 te = ""
 End If
 tc = tc & te
 Next t
 
 rangeOfInterest .Value = tc
 Next
End Sub

'Best Practice: Always declare Option Explicit at the top of your modules.
'Doing so requires all variable/fields to be declared before they are used
'or the code does not compile
Option Explicit
Sub a_organizar_protocolo()
 Application.DisplayFormulaBar = False
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
 Application.Interactive = False
 
On Error GoTo ErrorExit
 ActiveWorkbook.Save
 ActiveSheet.AutoFilterMode = False
 ActiveWindow.Zoom = 90
 Columns("O:P").ClearContents
 Columns("R:R").ClearContents
 FormatContent
 
 UpdateValues
 
 Cells.Validation.Delete
 Cells.FormatConditions.Delete
 Range("E2").End(xlDown).Select
ResetFlags:
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True
 Application.Interactive = True

 Exit Sub
ErrorExit:
 Debug.Print "Error: " & Err.Description
 Goto ResetFlags
End Sub
Private Sub FormatContent()
 With Cells
 .VerticalAlignment = xlCenter
 .HorizontalAlignment = xlCenter
 .Borders(xlDiagonalDown).LineStyle = xlNone
 .Borders(xlDiagonalUp).LineStyle = xlNone
 .WrapText = False
 .Orientation = 0
 .AddIndent = False
 .IndentLevel = 0
 .ShrinkToFit = False
 .ReadingOrder = xlContext
 .MergeCells = False
 With .Borders
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .Weight = xlThin
 End With
 With .Font
 .Name = "Calibri"
 .Size = 11
 .ColorIndex = xlAutomatic
 .Bold = False
 .Italic = False
 End With
 End With
 With Rows("1:1")
 .RowHeight = 32
 .Interior.ColorIndex = 49
 .WrapText = True
 With .Font
 .Size = 12
 .Bold = True
 .ColorIndex = 44
 End With
 End With
 With ActiveWindow
 .FreezePanes = False
 .SplitColumn = 0
 .SplitRow = 1
 .FreezePanes = True
 End With
 With Rows("2:" & Rows.Count)
 .RowHeight = 15
 .Interior.Color = xlNone
 End With
 
 FormatHeaders
 
 ApplyHorizontalAlignment "G", "J", "Q"
End Sub
Private Sub FormatHeaders()
 'Create a set of delimited format strings of the form <columnLetter:columnName:columnWidth>
 Dim columnFormatDefinitions As String
 columnFormatDefinitions = _
 "A:Lançamento:15," & _
 "B:Data de Recebimento:14," & _
 "C:Solicitante:20," & _
 "D:Espécie do Documento:30," & _
 "E:Número da Nota Fiscal:14," & _
 "F:Código do Fornecedor:11," & _
 "G:Fornecedor:40," & _
 "H:Centro de Custo:14," & _
 "I:Vencimento:14," & _
 "J:Valor:16," & _
 "K:Descrição:20," & _
 "L:Pedido:10," & _
 "M:Item do Pedido:8," & _
 "N:Pagamento:12," & _
 "O:Validação:5," & _
 "P:Prioridade:14," & _
 "Q:Observação:25," & _
 "R:Concatenar:25"
 
 Dim colLetter As String
 Dim colWidth As Long
 Dim colHeader As String
 Dim formatDefinition As Variant
 
 Dim formatElements As Variant
 For Each formatDefinition In Split(columnFormatDefinitions, ",")
 
 formatElements = Split(formatDefinition, ":")
 colLetter = formatElements(0)
 colHeader = formatElements(1)
 colWidth = CLng(formatElements(2))
 
 Columns(colLetter & ":" & colLetter).ColumnWidth = colWidth
 Range(colLetter & "1").Value = colHeader
 Next
End Sub
Private Sub ApplyHorizontalAlignment(ParamArray colLtrs() As Variant)
 
 Dim rangeOfInterest As Range
 Dim cLtr As Variant
 For Each cLtr In colLtrs
 Set rangeOfInterest = Range(Range(cLtr & "2"), Range(cLtr & Rows.Count))
 rangeOfInterest.HorizontalAlignment = xlLeft
 Next
End Sub
Private Sub UpdateValues()
 ReplaceSomeCharacters "G", "K"
 'ReplaceSomeCharacters replaces the code below
' Dim ea, e1, e2 As Range
' Set e1 = Range(Range("G2"), Range("G2").End(xlDown))
' Set e2 = Range(Range("K2"), Range("K2").End(xlDown))
' Set ea = Union(e1, e2)
' With ea
' .Replace What:=".", Replacement:=""
' .Replace What:="/", Replacement:=""
' .Replace What:=":", Replacement:=""
' .Replace What:="–", Replacement:="-"
' End With
 
 Dim r0, ra As Range
 Set r0 = Range(Range("E2"), Range("E2").End(xlDown))
 For Each ra In r0
 If Len(ra.Value) > 9 Then ra.Value = Right(ra.Value, 9)
 Next
 r0.Replace What:="x", Replacement:="0"
 Dim ta, tb As Range
 Dim t1, t2, t3, t4 As Range
 
 Dim t0 As Long
 
 t0 = Range("E:E").SpecialCells(xlCellTypeLastCell).Row
 
 ClearNonNumerics t0, "E2:E", "F2:F", "H2:H", "L2:M"
 'ClearNonNumerics replaces the code below
' Set t1 = Range("E2:E" & t0)
' Set t2 = Range("F2:F" & t0)
' Set t3 = Range("H2:H" & t0)
' Set t4 = Range("L2:M" & t0)
' Set tb = Union(t1, t2, t3, t4)
'
' Dim tc As String
' Dim td As String
' Dim te As String
' Dim t As Long
'
' For Each ta In tb
' tc = ""
' For t = 1 To Len(ta.Value)
' td = Mid(ta.Value, t, 1)
' If td Like "[0-9]" Then
' te = td
' Else
' te = ""
' End If
' tc = tc & te
' Next t
' ta.Value = tc
' Next
 Dim ya, yb As Range
 Set yb = Range(Range("J2"), Range("J2").End(xlDown))
 
 Dim yc As String
 Dim yd As String
 Dim ye As String
 Dim y As Long
 
 For Each ya In yb
 yc = ""
 For y = 1 To Len(ya.Value)
 yd = Mid(ya.Value, y, 1)
 If yd Like "[0-9],-" Then
 ye = yd
 Else
 ye = ""
 End If
 yc = yc & ye
 Next y
 ya.Value = yc * 1
 Next
 Dim ia, ib As Range
 Set ib = Range(Range("J2"), Range("J2").End(xlDown))
 For Each ia In ib
 If ia.Value < 0 Then
 With ia
 .Offset(0, -1).Value = "31/12/" & (Year(Date) + 1)
 .Offset(0, -2).Value = "NA"
 .Offset(0, 2).Value = "NA"
 .Offset(0, 3).Value = "NA"
 End With
 End If
 Next
 Dim oa, ob As Range
 Set ob = Range(Range("D2"), Range("D2").End(xlDown))
 For Each oa In ob
 If oa.Value = "Ouvidoria" Then
 With oa
 .Offset(0, -1).Value = oa.Value
 .Offset(0, 8).Value = "NA"
 .Offset(0, 9).Value = "NA"
 .Offset(0, 10).Value = "DEPÓSITO"
 End With
 End If
 Next
 Dim pa, pb, p1, p2 As Range
 Set p1 = Columns("H:H").SpecialCells(xlCellTypeBlanks)
 For Each pa In p1
 pa.Value = "Estoque"
 Next
 Set p2 = Range(Range("H2"), Range("H2").End(xlDown))
 For Each pb In p2
 If pb.Value = "Estoque" Then pb.Offset(0, -7).Value = pb.Value
 Next
 Dim k1, k2, k3, k4, k5, ka, kb, kaa, kbb As Range
 Set k1 = Range(Range("A2"), Range("A2").End(xlDown))
 Set k2 = Range(Range("C2"), Range("C2").End(xlDown))
 Set k3 = Range(Range("G2"), Range("G2").End(xlDown))
 Set k4 = Range(Range("K2"), Range("K2").End(xlDown))
 Set k5 = Range(Range("N2"), Range("N2").End(xlDown))
 Set ka = Union(k1, k2)
 Set kb = Union(k3, k4, k5)
 
 For Each kaa In ka
 kaa.Value = StrConv(kaa.Value, vbProperCase)
 Next kaa
 For Each kbb In kb
 kbb.Value = UCase(kbb.Value)
 Next kbb
End Sub
Private Sub ReplaceSomeCharacters (ParamArray colLtrs() As Variant)
 
 Dim rangeOfInterest As Range
 Dim cLtr As Variant
 For Each cLtr In colLtrs
 Set rangeOfInterest = Range(Range(cLtr & "2"), Range(cLtr & "2").End(xlDown))
 With rangeOfInterest
 .Replace What:=".", Replacement:=""
 .Replace What:="/", Replacement:=""
 .Replace What:=":", Replacement:=""
 .Replace What:="–", Replacement:="-"
 End With
 Next
End Sub
Private Sub ClearNonNumerics(ByVal eRow As Long, ParamArray rangeExpressions() As Variant)
 Dim tc As String
 Dim td As String
 Dim te As String
 Dim t As Long
 Dim rangeOfInterest As Range
 Dim rangeExpression As Variant
 For Each rangeExpression In rangeExpressions
 Set rangeOfInterest = Range(rangeExpression & eRow)
 tc = ""
 For t = 1 To Len(rangeOfInterest .Value)
 td = Mid(rangeOfInterest .Value, t, 1)
 If td Like "[0-9]" Then
 te = td
 Else
 te = ""
 End If
 tc = tc & te
 Next t
 
 rangeOfInterest .Value = tc
 Next
End Sub