VBA Code:
Sub OrderFormatting()
Range("A1:P40000").Select
With Selection
.Hyperlinks.Delete
With Selection
.Borders.LineStyle = xlNone
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
End With
Range("A1:P40000").UnMerge
End Sub
Sub CopyDeleteInsertSortInsertDelete()
Dim x As Long, LastRow As Long
Dim rng As Range
Range("D:E,K:O").Delete
Columns("A:O").EntireColumn.AutoFit
For Each rng In Range("D8", Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
rng.Offset(-1, -3).ReSize(rng.Count + 1, 2).FillDown
Next rng
End Sub
Sub DeleteBlankRows()
With Range("D6:D" & Cells(Rows.Count, "B").End(xlUp).Row)
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
Sub EndFormatting()
Rows(5).Insert
Range("A6").CurrentRegion.Sort Range("D6"), xlAscending, Range("A6"), , xlAscending, Header:=xlYes
Const DataCol As String = "D"
Const StartRow = 6
LastRow = Cells(Rows.Count, DataCol).End(xlUp).Row
Application.ScreenUpdating = False
For x = LastRow To StartRow + 1 Step -1
If Cells(x, DataCol).Value <> Cells(x - 1, DataCol) Then Range(DataCol & x & ":" & DataCol & x + 2).EntireRow.Insert
Next
Rows("5:5").EntireRow.Delete
Rows("6:8").EntireRow.Delete
End Sub
Sub UsualS()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
If Range("A" & i) = "01" And (Range("D" & i).Value = "bronx" Or Range("D" & i).Value = "brooklyn" Or Range("D" & i).Value = "queens") Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub
Sub RangeLabels11()
Application.ScreenUpdating = False
Dim area As Range, lngRentRow&
For Each area In Columns(1).SpecialCells(2).Areas
lngRentRow = area.Row + area.Rows.Count
With Cells(lngRentRow, 7)
.Value = "Rent"
.Font.Bold = True
.Interior.Color = 5296274
With .Offset(1)
.Value = "Cash"
.Font.Bold = True
.Interior.Color = 65535
End With
End With
Next area
Columns(7).AutoFit
Application.ScreenUpdating = True
ActiveCell.Columns("G:G").EntireColumn.EntireColumn.AutoFit
End Sub
Sub Sorting()
Dim UsdRws As Long
UsdRws = Range("A" & Rows.Count).End(xlUp).Row
With Range("A:A").SpecialCells(xlConstants)
With Range(.Areas(.Areas.Count - 1), Range("A" & UsdRws)).ReSize(, 9)
.Sort .Range("A1"), xlAscending, .Range("G1"), , xlAscending, Header:=xlNo
End With
End With
End Sub
Sub States()
Dim States(4) As Variant
Dim i As Long
States(1) = "nc"
States(2) = "sc"
States(3) = "wa"
States(4) = "ga"
With ActiveSheet
For i = 1 To 4
.AutoFilterMode = False
With Range("d1", Range("d" & Rows.Count).End(xlUp))
.AutoFilter 1, "*" & States(i) & "*"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
Next i
End With
End Sub
Sub UsualS565()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
If Range("A" & i) = "01" And (Range("D" & i).Value = "bronx" Or Range("D" & i).Value = "brooklyn" Or Range("D" & i).Value = "queens") Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub
Sub GetLastRow()
Range("A" & Rows.Count).End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
End SubI have a code which calls all of these macros. Would be great if they could be consolidated and tweaked to make faster. Thank you.
