Whats wrong with my macro

[rachelleperez93]

Hi Guys,

I recently edited my macro, and now I have to run it twice for it to work (ie, sort)
Basically, I wanted it to do the following:

1. Put all letters to CAPS
2. To put all borders for only data inputted
3. To make all data centered
4. To add a column before a "Weight" Column Titles "TECHRESET VALUE"
5. To Sort ALL data by two headers named "TYPE" and "MODEL"

COULD ANYONE GIVE ME SUGGESTIONS PLEASE =(

Here is the Macro below:

Sub Format()
'
' Format Macro
'




Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Cell As Range
On Error Resume Next
For Each Cell In Cells.SpecialCells(xlConstants, xlTextValues)
Cell.Formula = UCase(Cell.Formula)
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


'
   
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Columns("A:Z")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    
  
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:Z")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("F3").Select
    Cells.Replace what:=", NIC", Replacement:="", lookat:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace what:="NIC", Replacement:="WORKING", lookat:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
Dim lngLstCol As Long, lngLstRow As Long


lngLstRow = ActiveSheet.UsedRange.Rows.Count
lngLstCol = ActiveSheet.UsedRange.Columns.Count


For Each rngCell In Range("A1:A" & lngLstRow)
    If rngCell.Value > "" Then
        r = rngCell.Row
        c = rngCell.Column
        Range(Cells(r, c), Cells(r, lngLstCol)).Select
            With Selection.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
    End If
Next








'Setup column names
Col1name = "TYPE"
Col2name = "MODEL"


'Find cols
For Each Cell In Range("A1:" & Range("A1").End(xlToRight).Address)
    If Cell.Value = Col1name Then
        Col1 = Cell.Column
    End If
    If Cell.Value = Col2name Then
        Col2 = Cell.Column
    End If
Next


'Below two line:- if they are blank e.g. column not found it will error so a small bit of error handling
If Col1 = "" Then Exit Sub
If Col2 = "" Then Exit Sub


'Find last row - dynamic part
lastrow = ActiveSheet.Range("A100000").End(xlUp).Row


'Convert col numer to name
Col1 = Split(Cells(1, Col1).Address(True, False), "$")
Col2 = Split(Cells(1, Col2).Address(True, False), "$")


'Sort
With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range(Col1(0) & "2:" & Col1(0) & lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SortFields.Add Key:=Range(Col2(0) & "2:" & Col2(0) & lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal


    .SetRange Range("A:Z" & lastrow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


 Dim rngWeightHeader As Range
    Dim rngHeaders As Range


    Set rngHeaders = Range("1:1") 'Looks in entire first row.
    Set rngWeightHeader = rngHeaders.Find(what:="Weight", After:=Cells(1, 1))


    rngWeightHeader.Offset(0, 0).EntireColumn.Insert
    rngWeightHeader.Offset(0, -1).Value = "TECHRESET VALUE"
        
End Sub

 

[pbornemeier]

Well, I made it work and added a few comments along the way. Make sure it does what you wanted it to do.

Option Explicit 'Highly recommended

Sub Format()
    
    'These variables were not typed
    Dim rngCell As Range
    Dim r As Long
    Dim c As Long
    Dim Col1Name As String
    Dim Col2Name As String
    Dim Col1 As Variant
    Dim Col2 As Variant
    Dim LastRow As Long
    
    
    'Nice to have all Dim statments at top
    Dim Cell As Range
    Dim lngLstCol As Long, lngLstRow As Long
    Dim rngWeightHeader As Range
    Dim rngHeaders As Range
    
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    
    On Error Resume Next    'Not sure why you needed error checking here, but turn it off as soon as the
                            'part of the code where you could not trap for errors is complete
                            'or you won't see any errors that might let you know why your code is not working
    For Each Cell In Cells.SpecialCells(xlConstants, xlTextValues)
        Cell.Formula = UCase(Cell.Formula)
    Next
    On Error GoTo 0         'Not in original code
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
'    'This section is overwritten by a subsequent sort section, so get rid of it
'    With ActiveWorkbook.Worksheets("Sheet1").Sort
'        .SetRange Columns("A:Z")
'        .Header = xlYes
'        .MatchCase = False
'        .Orientation = xlTopToBottom
'        .SortMethod = xlPinYin
'        .Apply
'    End With
        
'        'This section is overwritten by next section, so get rid of it
'        With Selection  'Selection is not yet defined, could be anything
'            .HorizontalAlignment = xlGeneral
'            .VerticalAlignment = xlBottom
'            .Orientation = 0
'            .AddIndent = False
'            .IndentLevel = 0
'            .ShrinkToFit = False
'            .ReadingOrder = xlContext
'            .MergeCells = False
'        End With


        With Selection 'Selection is not defined in code, could be anything
                        'Substitute the range you want to format for "Selection"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        
        
    'You have not defined which columns will be keys or ascending, descending or custom
    'Since you have set the range of A:Z, A will be the key and the sort order
    '   will be the sort order that was last used in Excel
        With ActiveWorkbook.Worksheets("Sheet1").Sort
            .SetRange Range("A:Z")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        'Range("F3").Select  'not needed
        
        'The 2 replace statements will act on the entire active sheet
        Cells.Replace what:=", NIC", Replacement:="", lookat:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Cells.Replace what:="NIC", Replacement:="WORKING", lookat:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
            
    
    
    'These may return more rows and columns than are currently filled in due to what the UsedRange is
    lngLstRow = ActiveSheet.UsedRange.Rows.Count
    lngLstCol = ActiveSheet.UsedRange.Columns.Count
    
    'If your data has no fully blank rows or columns and starts in A1 you can use
    lngLstRow = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
    lngLstCol = ActiveSheet.Range("A1").CurrentRegion.Columns.Count
    
    'This code puts borders on rows that have a non-blank column A
    For Each rngCell In Range("A1:A" & lngLstRow)
        If rngCell.Value > "" Then
            r = rngCell.Row
            c = rngCell.Column
'            Range(Cells(r, c), Cells(r, lngLstCol)).Select
'                With Selection.Borders
                With Range(Cells(r, c), Cells(r, lngLstCol)).Borders    'Don't select unless you have to, not selection is faster
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
        End If
    Next
    
    'Setup column names
    Col1Name = "TYPE"
    Col2Name = "MODEL"
    
    'Find cols
    For Each Cell In Range("A1:" & Range("A1").End(xlToRight).Address)
        If Cell.Value = Col1Name Then
            Col1 = Cell.Column
        End If
        If Cell.Value = Col2Name Then
            Col2 = Cell.Column
        End If
    Next
    
    'Below two line:- if they are blank e.g. column not found it will error so a small bit of error handling
    If Col1 = "" Then Exit Sub
    If Col2 = "" Then Exit Sub
    
    'Find last row - dynamic part
    LastRow = ActiveSheet.Range("A100000").End(xlUp).Row
    
    'Starts from bottom
    LastRow = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
    
    'Convert col numer to name
    Col1 = Split(Cells(1, Col1).Address(True, False), "$")
    Col2 = Split(Cells(1, Col2).Address(True, False), "$")
    
    'Sort
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range(Col1(0) & "2:" & Col1(0) & LastRow) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range(Col2(0) & "2:" & Col2(0) & LastRow) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:Z" & LastRow)   'Didn't have A1, only A
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    
    Set rngHeaders = Range("1:1") 'Looks in entire first row.
    Set rngWeightHeader = rngHeaders.Find(what:="Weight", After:=Cells(1, 1))


    rngWeightHeader.Offset(0, 0).EntireColumn.Insert
    rngWeightHeader.Offset(0, -1).Value = "TECHRESET VALUE"
        
End Sub