rachelleperez93
New Member
- Joined
- Nov 9, 2018
- Messages
- 1
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:
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:
Code:
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
Last edited by a moderator: