Help perfecting some VBA from a recorded macro

[thooper76]

Hi all,

This is my first post on this board so I hope I'm not out of line here. I recorded a macro (I know it's not the ideal way but I needed to get started, I'm also currently learning VBA from some books but I need to get a resolution here before I can get through them all) and I need the ranges, and sorted ranges to be less specific. I've tried Googling what I need to change, and although the help seemed to make sense to me I couldn't get it to work.

If I were to post the the VBA on here could someone help with some advice, or possibly make the changes for me?

A colleague of mine suggested 'Dim-ing' some ranges which would then make it easier...

Anywhere before I go in to more depth is that something I can be helped with?

T

[VoG]

Try posting your code.

[thooper76]

Try posting your code.

VoG, thanks...

Sub RSR2()
' RSR2 Macro
Cells.Select
With Selection.Font
.Name = "Trebuchet MS"
.Size = 8
End With
Columns("D:R").Select
Selection.NumberFormat = _
"_-[$£-809]* #,##0.00_-;-[$£-809]* #,##0.00_-;_-[$£-809]* ""-""??_-;_-@_-"
Range("D4:P4").Select
Selection.NumberFormat = "General"
Range("D5:R5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A5:R5").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A5:R153").Select
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Add Key:=Range( _
"R5:R153"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ABERDEEN").Sort
.SetRange Range("A5:R153")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A5:B14").Select
Selection.Copy
Range("T5").Select
ActiveSheet.Paste
Range("R5:R14").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll ToRight:=1
Range("V5").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A5:R5").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A5:R153").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Add Key:=Range( _
"R5:R153"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ABERDEEN").Sort
.SetRange Range("A5:R153")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A5:B14").Select
Selection.Copy
Range("W5").Select
ActiveSheet.Paste
Range("R5:R14").Select
Application.CutCopyMode = False
Selection.Copy
Range("Y5").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A5:R5").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A5:R153").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Add Key:=Range( _
"C5:C153"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Add Key:=Range( _
"A5:A153"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ABERDEEN").Sort
.SetRange Range("A5:R153")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("Q3").Select
ActiveCell.FormulaR1C1 = "Last 3 Month"
Range("Q4").Select
ActiveCell.FormulaR1C1 = "Average"
Range("R3").Select
ActiveCell.FormulaR1C1 = "=RC[-3]"
Range("R4").Select
ActiveCell.FormulaR1C1 = "vs Average"
Range("R5").Select
ActiveWindow.SmallScroll ToRight:=6
Range("T3:V3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Uptraders"
Range("T4").Select
ActiveCell.FormulaR1C1 = "Account No"
Range("U4").Select
ActiveCell.FormulaR1C1 = "Account Name"
Range("V4").Select
ActiveCell.FormulaR1C1 = "Variance"
Range("W3:Y3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Downtraders"
Range("W4").Select
ActiveCell.FormulaR1C1 = "Account No"
Range("X4").Select
ActiveCell.FormulaR1C1 = "Account Name"
Range("Y4").Select
ActiveCell.FormulaR1C1 = "Variance"
Range("T3:Y14").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub
I should probably mention now that the reason I need to use this is because I have over 35 tabs where I need to complete the same process, the columns, and first data row will always remain the same (Columns A to R and start row 5), but the total rows will change, also the final data row is always a total and shouldn't ever be included in the sorted range. I know you have to offset and I did play around with this but I've copied the original code to ensure I didn't lose anything important.

Thanks in anticipation...

[CatDaddy]

post code wrapped in vba tags

[thooper76]

Sub RSR2()
'
' RSR2 Macro
'

'
Cells.Select
With Selection.Font
.Name = "Trebuchet MS"
.Size = 8
End With
Columns("D:R").Select
Selection.NumberFormat = _
"_-[$£-809]* #,##0.00_-;-[$£-809]* #,##0.00_-;_-[$£-809]* ""-""??_-;_-@_-"
Range("D4:P4").Select
Selection.NumberFormat = "General"
Range("D5:R5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A5:R5").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A5:R153").Select
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Add Key:=Range( _
"R5:R153"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ABERDEEN").Sort
.SetRange Range("A5:R153")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A5:B14").Select
Selection.Copy
Range("T5").Select
ActiveSheet.Paste
Range("R5:R14").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll ToRight:=1
Range("V5").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A5:R5").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A5:R153").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Add Key:=Range( _
"R5:R153"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ABERDEEN").Sort
.SetRange Range("A5:R153")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A5:B14").Select
Selection.Copy
Range("W5").Select
ActiveSheet.Paste
Range("R5:R14").Select
Application.CutCopyMode = False
Selection.Copy
Range("Y5").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A5:R5").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A5:R153").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Add Key:=Range( _
"C5:C153"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("ABERDEEN").Sort.SortFields.Add Key:=Range( _
"A5:A153"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ABERDEEN").Sort
.SetRange Range("A5:R153")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("Q3").Select
ActiveCell.FormulaR1C1 = "Last 3 Month"
Range("Q4").Select
ActiveCell.FormulaR1C1 = "Average"
Range("R3").Select
ActiveCell.FormulaR1C1 = "=RC[-3]"
Range("R4").Select
ActiveCell.FormulaR1C1 = "vs Average"
Range("R5").Select
ActiveWindow.SmallScroll ToRight:=6
Range("T3:V3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Uptraders"
Range("T4").Select
ActiveCell.FormulaR1C1 = "Account No"
Range("U4").Select
ActiveCell.FormulaR1C1 = "Account Name"
Range("V4").Select
ActiveCell.FormulaR1C1 = "Variance"
Range("W3:Y3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Downtraders"
Range("W4").Select
ActiveCell.FormulaR1C1 = "Account No"
Range("X4").Select
ActiveCell.FormulaR1C1 = "Account Name"
Range("Y4").Select
ActiveCell.FormulaR1C1 = "Variance"
Range("T3:Y14").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub


(Thanks)

[CatDaddy]

what is it you are trying to accomplish exactly?

[Paul_Hossler]

some ideas for you to think about.

1. Usually no need to .Select an object
2. The macro recorder remembers everything, scrolling, clicking, etc. You can usually clean those up
3. Dim-ing a variable and using it will make code more readable
4. The macro recorder will remember the ranges that you were using, Range ("A1:Z26").Font.Size = 12
5. Unless your data will ALWAYS be there, try to let Excel do the work, i.e. Range("A1").CurrentRegion.Font.Size = 12. That way, no matter how many rows and columns, you'll get the whole block.
6. .Offset(...) and .Resize(...) will be useful, so it's worth reading up on them

As an example of just some basic cleanup you can do to recorder code


Sub RSR2()

Dim ws As Worksheet

Set ws = ActiveWorkbook.Worksheets("ABERDEEN")

With ws.Cells.Font
.Name = "Trebuchet MS"
.Size = 8
End With

ws.Columns("D:R").NumberFormat = _
"_-[$£-809]* #,##0.00_-;-[$£-809]* #,##0.00_-;_-[$£-809]* ""-""??_-;_-@_-"

ws.Range("D4:P4").NumberFormat = "General"

With Range(ws.Range("D5"), Range("R5").End(xlDown))
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=0"
.FormatConditions(1).SetFirstPriority
With .FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With

.FormatConditions(1).StopIfTrue = False
End With

With Range(ws.Range("A5"), ws.Range("R5").End(xlDown)).Sort
.SortFields.Clear
.Sort.SortFields.Add Key:=Range("R5:R153"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

.SetRange Range("A5:R153")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Call ws.Range("A5:B14").Copy(ws.Range("T5"))


NO idea if this will actually do what you want since I have no idea about your actual data, etc.


Paul

[thooper76]

NO idea if this will actually do what you want since I have no idea about your actual data, etc.


Paul

Paul,

That's definitely within the area of what I'm trying to achieve, I'm going to take this and your suggestions and see if I can tweak it slightly.

I should have also mentioned I didn't want the sheet name to be specified as I also intend to add a loop in to repeat this sub through various sheets. If I remember correctly though Excel will still run the sub without the sheet reference as long as you always want it to run on the current sheet?

Thanks though as this has given me enough to get going with...

Tom

[thooper76]

Oh also, you'll notice within my sort range it specifies 'Range("R5:R153")'. This is because the sheet I recorded on had this range, however other sheets won't have this range. I had tried using this after searching for a suggestion but wanted to check if it looks right?

Range([R5], [R5].End(xlDown).Offset(-1, 0))

[Paul_Hossler]

Well, this will go through all sheets (except for one) and sort the data by col A and col B

Assumes that data is in a 'block' cornered in A1


Option Explicit
Sub SortDemo()
Dim ws As Worksheet
Dim rData As Range, rDataWithoutHeader As Range


Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets

If ws.Name = "DontSortThisOne" Then GoTo NextWorksheet

Set rData = ws.Cells(1, 1).CurrentRegion
Set rDataWithoutHeader = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)

With ws.Sort
.SortFields.Clear
.SortFields.Add Key:=rDataWithoutHeader.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rDataWithoutHeader.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SetRange rData
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
NextWorksheet:
Next
Application.ScreenUpdating = True
End Sub



Paul