Consulting

Results 1 to 4 of 4

Thread: Need Help Re-writing Recorded Macro

  1. 12-07-2018, 12:17 PM #1
    leighane
    leighane is offline
    VBAX Newbie
    Joined
    Dec 2018
    Posts
    2
    Location

    Exclamation Need Help Re-writing Recorded Macro

    I don't have any real knowledge of writing code and am only fairly familiar with macros. A coworker recorded a very lengthy macro that I've been adding to, but I've run into a snag with some formatting/auto-fill things she has in the macro. In the simplest of terms, she has the formatting/auto-fill ending at 5000 lines. I can see everywhere in the code that she has done this, but I'm not sure how to change it so it'll function the way we need it to. Sometimes the report is less than 5000 lines and sometimes it's greater. So everywhere that she has specified '5000' lines needs to be changed in someway so that it will vary based on the data in the report being ran. If that makes sense? Here are some snipits from the code:

    Columns("G:G").EntireColumn.AutoFit
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G5000"), Type:=xlFillDefault
    Range("G2:G5000").Select


    Selection.AutoFill Destination:=Range("J2:J5000"), Type:=xlFillDefault
    Range("J2:J5000").Select

    I feel like I just need to change the range to something that varies rather than 5000 but I can't figure out how that's done? I feel like it would be something silly like Range("J2:JVariable")

    Please help if you can! THANK YOU!
    Reply With Quote Reply With Quote
  2. 12-07-2018, 01:57 PM #2
    Fluff
    Fluff is offline
    VBAX Contributor
    Joined
    Mar 2018
    Posts
    128
    Hi & welcome to the board
    Something like this 
    Dim Lr As Long
Lr = Range("A" & Rows.Count).End(xlUp).Row
Range("G2").AutoFill Destination:=Range("G2:G" & Lr), Type:=xlFillDefault
    This use col A to find the last used row.
    Reply With Quote Reply With Quote
  3. 12-11-2018, 02:37 PM #3
    leighane
    leighane is offline
    VBAX Newbie
    Joined
    Dec 2018
    Posts
    2
    Location
    I still can't figure it out I guess I'm replacing the wrong thing....I need to replace everywhere there's 5000 but I'm not familiar with the coding it's telling it to do. Here's the very lengthy current macro: 

    

    
	
    Sub ExpRepRev()'
' ExpRepRev Macro
' Revised exp report to add policy #, delete columns not used and format for printing by CSR, expiration date
'
' Keyboard Shortcut: Ctrl+e
'
    Rows("1:3").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Columns("C:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:F").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=4
    Columns("F:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:L").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=3
    Columns("L:X").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1:K1").Select
    Range("K1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599963377788629
        .PatternTintAndShade = 0
    End With
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("E22:E23").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    Range("A1:K1").Select
    Range("K1").Activate
    Selection.Font.Bold = True
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("A:A").Select
    Selection.ColumnWidth = 10.44
    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
    Columns("C:C").ColumnWidth = 34.11
    Columns("D:D").Select
    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
    Columns("E:E").ColumnWidth = 28
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Bill"
    Columns("H:H").Select
    Selection.NumberFormat = "$#,##0.00"
    Selection.ColumnWidth = 11.67
    Selection.ColumnWidth = 13
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Exec"
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "CSR"
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Dept."
    Range("M25").Select
    ActiveCell.FormulaR1C1 = "Small Commercial"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Bill Method'!R1C1:R5C2,2,)"
    Columns("G:G").Select
    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
    Columns("G:G").EntireColumn.AutoFit
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G5000"), Type:=xlFillDefault
    Range("G2:G5000").Select
    ActiveWindow.ScrollRow = 1166
    ActiveWindow.ScrollRow = 1164
    ActiveWindow.ScrollRow = 1163
    ActiveWindow.ScrollRow = 1160
    ActiveWindow.ScrollRow = 1108
    ActiveWindow.ScrollRow = 1079
    ActiveWindow.ScrollRow = 1062
    ActiveWindow.ScrollRow = 969
    ActiveWindow.ScrollRow = 956
    ActiveWindow.ScrollRow = 945
    ActiveWindow.ScrollRow = 862
    ActiveWindow.ScrollRow = 851
    ActiveWindow.ScrollRow = 839
    ActiveWindow.ScrollRow = 828
    ActiveWindow.ScrollRow = 775
    ActiveWindow.ScrollRow = 767
    ActiveWindow.ScrollRow = 757
    ActiveWindow.ScrollRow = 677
    ActiveWindow.ScrollRow = 663
    ActiveWindow.ScrollRow = 652
    ActiveWindow.ScrollRow = 551
    ActiveWindow.ScrollRow = 535
    ActiveWindow.ScrollRow = 521
    ActiveWindow.ScrollRow = 507
    ActiveWindow.ScrollRow = 414
    ActiveWindow.ScrollRow = 403
    ActiveWindow.ScrollRow = 393
    ActiveWindow.ScrollRow = 329
    ActiveWindow.ScrollRow = 319
    ActiveWindow.ScrollRow = 311
    ActiveWindow.ScrollRow = 300
    ActiveWindow.ScrollRow = 245
    ActiveWindow.ScrollRow = 237
    ActiveWindow.ScrollRow = 229
    ActiveWindow.ScrollRow = 220
    ActiveWindow.ScrollRow = 206
    ActiveWindow.ScrollRow = 198
    ActiveWindow.ScrollRow = 190
    ActiveWindow.ScrollRow = 180
    ActiveWindow.ScrollRow = 120
    ActiveWindow.ScrollRow = 111
    ActiveWindow.ScrollRow = 97
    ActiveWindow.ScrollRow = 89
    ActiveWindow.ScrollRow = 57
    ActiveWindow.ScrollRow = 53
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 1
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Exec!R1C1:R45C2,2,)"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J5000"), Type:=xlFillDefault
    Range("J2:J5000").Select
    ActiveWindow.ScrollRow = 1164
    ActiveWindow.ScrollRow = 1163
    ActiveWindow.ScrollRow = 1158
    ActiveWindow.ScrollRow = 1152
    ActiveWindow.ScrollRow = 1054
    ActiveWindow.ScrollRow = 1026
    ActiveWindow.ScrollRow = 1013
    ActiveWindow.ScrollRow = 928
    ActiveWindow.ScrollRow = 915
    ActiveWindow.ScrollRow = 901
    ActiveWindow.ScrollRow = 890
    ActiveWindow.ScrollRow = 833
    ActiveWindow.ScrollRow = 827
    ActiveWindow.ScrollRow = 821
    ActiveWindow.ScrollRow = 813
    ActiveWindow.ScrollRow = 808
    ActiveWindow.ScrollRow = 789
    ActiveWindow.ScrollRow = 784
    ActiveWindow.ScrollRow = 778
    ActiveWindow.ScrollRow = 773
    ActiveWindow.ScrollRow = 772
    ActiveWindow.ScrollRow = 767
    ActiveWindow.ScrollRow = 764
    ActiveWindow.ScrollRow = 762
    ActiveWindow.ScrollRow = 757
    ActiveWindow.ScrollRow = 754
    ActiveWindow.ScrollRow = 750
    ActiveWindow.ScrollRow = 748
    ActiveWindow.ScrollRow = 745
    ActiveWindow.ScrollRow = 742
    ActiveWindow.ScrollRow = 739
    ActiveWindow.ScrollRow = 735
    ActiveWindow.ScrollRow = 732
    ActiveWindow.ScrollRow = 731
    ActiveWindow.ScrollRow = 728
    ActiveWindow.ScrollRow = 726
    ActiveWindow.ScrollRow = 721
    ActiveWindow.ScrollRow = 716
    ActiveWindow.ScrollRow = 712
    ActiveWindow.ScrollRow = 709
    ActiveWindow.ScrollRow = 704
    ActiveWindow.ScrollRow = 699
    ActiveWindow.ScrollRow = 688
    ActiveWindow.ScrollRow = 680
    ActiveWindow.ScrollRow = 674
    ActiveWindow.ScrollRow = 669
    ActiveWindow.ScrollRow = 664
    ActiveWindow.ScrollRow = 658
    ActiveWindow.ScrollRow = 652
    ActiveWindow.ScrollRow = 646
    ActiveWindow.ScrollRow = 639
    ActiveWindow.ScrollRow = 623
    ActiveWindow.ScrollRow = 614
    ActiveWindow.ScrollRow = 608
    ActiveWindow.ScrollRow = 598
    ActiveWindow.ScrollRow = 589
    ActiveWindow.ScrollRow = 540
    ActiveWindow.ScrollRow = 530
    ActiveWindow.ScrollRow = 521
    ActiveWindow.ScrollRow = 513
    ActiveWindow.ScrollRow = 477
    ActiveWindow.ScrollRow = 467
    ActiveWindow.ScrollRow = 459
    ActiveWindow.ScrollRow = 453
    ActiveWindow.ScrollRow = 447
    ActiveWindow.ScrollRow = 440
    ActiveWindow.ScrollRow = 423
    ActiveWindow.ScrollRow = 420
    ActiveWindow.ScrollRow = 414
    ActiveWindow.ScrollRow = 411
    ActiveWindow.ScrollRow = 404
    ActiveWindow.ScrollRow = 403
    ActiveWindow.ScrollRow = 399
    ActiveWindow.ScrollRow = 395
    ActiveWindow.ScrollRow = 393
    ActiveWindow.ScrollRow = 388
    ActiveWindow.ScrollRow = 385
    ActiveWindow.ScrollRow = 381
    ActiveWindow.ScrollRow = 376
    ActiveWindow.ScrollRow = 373
    ActiveWindow.ScrollRow = 370
    ActiveWindow.ScrollRow = 365
    ActiveWindow.ScrollRow = 362
    ActiveWindow.ScrollRow = 357
    ActiveWindow.ScrollRow = 354
    ActiveWindow.ScrollRow = 347
    ActiveWindow.ScrollRow = 344
    ActiveWindow.ScrollRow = 340
    ActiveWindow.ScrollRow = 335
    ActiveWindow.ScrollRow = 330
    ActiveWindow.ScrollRow = 325
    ActiveWindow.ScrollRow = 291
    ActiveWindow.ScrollRow = 284
    ActiveWindow.ScrollRow = 278
    ActiveWindow.ScrollRow = 273
    ActiveWindow.ScrollRow = 269
    ActiveWindow.ScrollRow = 261
    ActiveWindow.ScrollRow = 250
    ActiveWindow.ScrollRow = 247
    ActiveWindow.ScrollRow = 240
    ActiveWindow.ScrollRow = 235
    ActiveWindow.ScrollRow = 231
    ActiveWindow.ScrollRow = 226
    ActiveWindow.ScrollRow = 221
    ActiveWindow.ScrollRow = 218
    ActiveWindow.ScrollRow = 213
    ActiveWindow.ScrollRow = 209
    ActiveWindow.ScrollRow = 201
    ActiveWindow.ScrollRow = 196
    ActiveWindow.ScrollRow = 191
    ActiveWindow.ScrollRow = 190
    ActiveWindow.ScrollRow = 185
    ActiveWindow.ScrollRow = 182
    ActiveWindow.ScrollRow = 180
    ActiveWindow.ScrollRow = 177
    ActiveWindow.ScrollRow = 172
    ActiveWindow.ScrollRow = 171
    ActiveWindow.ScrollRow = 168
    ActiveWindow.ScrollRow = 163
    ActiveWindow.ScrollRow = 161
    ActiveWindow.ScrollRow = 157
    ActiveWindow.ScrollRow = 153
    ActiveWindow.ScrollRow = 152
    ActiveWindow.ScrollRow = 147
    ActiveWindow.ScrollRow = 139
    ActiveWindow.ScrollRow = 135
    ActiveWindow.ScrollRow = 133
    ActiveWindow.ScrollRow = 130
    ActiveWindow.ScrollRow = 127
    ActiveWindow.ScrollRow = 124
    ActiveWindow.ScrollRow = 120
    ActiveWindow.ScrollRow = 117
    ActiveWindow.ScrollRow = 114
    ActiveWindow.ScrollRow = 111
    ActiveWindow.ScrollRow = 108
    ActiveWindow.ScrollRow = 106
    ActiveWindow.ScrollRow = 103
    ActiveWindow.ScrollRow = 100
    ActiveWindow.ScrollRow = 98
    ActiveWindow.ScrollRow = 97
    ActiveWindow.ScrollRow = 95
    ActiveWindow.ScrollRow = 94
    ActiveWindow.ScrollRow = 92
    ActiveWindow.ScrollRow = 89
    ActiveWindow.ScrollRow = 84
    ActiveWindow.ScrollRow = 81
    ActiveWindow.ScrollRow = 79
    ActiveWindow.ScrollRow = 76
    ActiveWindow.ScrollRow = 75
    ActiveWindow.ScrollRow = 73
    ActiveWindow.ScrollRow = 70
    ActiveWindow.ScrollRow = 68
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 62
    ActiveWindow.ScrollRow = 60
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 56
    ActiveWindow.ScrollRow = 53
    ActiveWindow.ScrollRow = 51
    ActiveWindow.ScrollRow = 49
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 29
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 1
    Range("J4").Select
    Columns("J:J").ColumnWidth = 18.11
    Columns("J:J").EntireColumn.AutoFit
    Columns("J:J").Select
    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
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],CSR!R1C1:R28C2,2,)"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L5000"), Type:=xlFillDefault
    Range("L2:L5000").Select
    ActiveWindow.ScrollRow = 1165
    ActiveWindow.ScrollRow = 1163
    ActiveWindow.ScrollRow = 1162
    ActiveWindow.ScrollRow = 1160
    ActiveWindow.ScrollRow = 1159
    ActiveWindow.ScrollRow = 1155
    ActiveWindow.ScrollRow = 1154
    ActiveWindow.ScrollRow = 1148
    ActiveWindow.ScrollRow = 1143
    ActiveWindow.ScrollRow = 1138
    ActiveWindow.ScrollRow = 1121
    ActiveWindow.ScrollRow = 1111
    ActiveWindow.ScrollRow = 1077
    ActiveWindow.ScrollRow = 1066
    ActiveWindow.ScrollRow = 1037
    ActiveWindow.ScrollRow = 1029
    ActiveWindow.ScrollRow = 1020
    ActiveWindow.ScrollRow = 1014
    ActiveWindow.ScrollRow = 1007
    ActiveWindow.ScrollRow = 988
    ActiveWindow.ScrollRow = 984
    ActiveWindow.ScrollRow = 977
    ActiveWindow.ScrollRow = 971
    ActiveWindow.ScrollRow = 968
    ActiveWindow.ScrollRow = 962
    ActiveWindow.ScrollRow = 949
    ActiveWindow.ScrollRow = 943
    ActiveWindow.ScrollRow = 936
    ActiveWindow.ScrollRow = 929
    ActiveWindow.ScrollRow = 921
    ActiveWindow.ScrollRow = 913
    ActiveWindow.ScrollRow = 903
    ActiveWindow.ScrollRow = 873
    ActiveWindow.ScrollRow = 866
    ActiveWindow.ScrollRow = 851
    ActiveWindow.ScrollRow = 840
    ActiveWindow.ScrollRow = 705
    ActiveWindow.ScrollRow = 692
    ActiveWindow.ScrollRow = 680
    ActiveWindow.ScrollRow = 669
    ActiveWindow.ScrollRow = 612
    ActiveWindow.ScrollRow = 601
    ActiveWindow.ScrollRow = 584
    ActiveWindow.ScrollRow = 544
    ActiveWindow.ScrollRow = 535
    ActiveWindow.ScrollRow = 528
    ActiveWindow.ScrollRow = 524
    ActiveWindow.ScrollRow = 516
    ActiveWindow.ScrollRow = 497
    ActiveWindow.ScrollRow = 489
    ActiveWindow.ScrollRow = 483
    ActiveWindow.ScrollRow = 476
    ActiveWindow.ScrollRow = 470
    ActiveWindow.ScrollRow = 465
    ActiveWindow.ScrollRow = 457
    ActiveWindow.ScrollRow = 446
    ActiveWindow.ScrollRow = 440
    ActiveWindow.ScrollRow = 434
    ActiveWindow.ScrollRow = 431
    ActiveWindow.ScrollRow = 424
    ActiveWindow.ScrollRow = 418
    ActiveWindow.ScrollRow = 412
    ActiveWindow.ScrollRow = 405
    ActiveWindow.ScrollRow = 402
    ActiveWindow.ScrollRow = 396
    ActiveWindow.ScrollRow = 390
    ActiveWindow.ScrollRow = 383
    ActiveWindow.ScrollRow = 379
    ActiveWindow.ScrollRow = 372
    ActiveWindow.ScrollRow = 368
    ActiveWindow.ScrollRow = 361
    ActiveWindow.ScrollRow = 357
    ActiveWindow.ScrollRow = 350
    ActiveWindow.ScrollRow = 344
    ActiveWindow.ScrollRow = 341
    ActiveWindow.ScrollRow = 335
    ActiveWindow.ScrollRow = 328
    ActiveWindow.ScrollRow = 317
    ActiveWindow.ScrollRow = 312
    ActiveWindow.ScrollRow = 308
    ActiveWindow.ScrollRow = 301
    ActiveWindow.ScrollRow = 297
    ActiveWindow.ScrollRow = 294
    ActiveWindow.ScrollRow = 262
    ActiveWindow.ScrollRow = 249
    ActiveWindow.ScrollRow = 245
    ActiveWindow.ScrollRow = 240
    ActiveWindow.ScrollRow = 234
    ActiveWindow.ScrollRow = 227
    ActiveWindow.ScrollRow = 223
    ActiveWindow.ScrollRow = 216
    ActiveWindow.ScrollRow = 213
    ActiveWindow.ScrollRow = 207
    ActiveWindow.ScrollRow = 201
    ActiveWindow.ScrollRow = 194
    ActiveWindow.ScrollRow = 188
    ActiveWindow.ScrollRow = 182
    ActiveWindow.ScrollRow = 175
    ActiveWindow.ScrollRow = 171
    ActiveWindow.ScrollRow = 164
    ActiveWindow.ScrollRow = 141
    ActiveWindow.ScrollRow = 136
    ActiveWindow.ScrollRow = 130
    ActiveWindow.ScrollRow = 125
    ActiveWindow.ScrollRow = 119
    ActiveWindow.ScrollRow = 112
    ActiveWindow.ScrollRow = 108
    ActiveWindow.ScrollRow = 103
    ActiveWindow.ScrollRow = 86
    ActiveWindow.ScrollRow = 79
    ActiveWindow.ScrollRow = 75
    ActiveWindow.ScrollRow = 70
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 60
    ActiveWindow.ScrollRow = 57
    ActiveWindow.ScrollRow = 54
    ActiveWindow.ScrollRow = 51
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 29
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Columns("L:L").Select
    Columns("L:L").EntireColumn.AutoFit
    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
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Dept.!R1C1:R7C2,2,)"
    Range("N2").Select
    Selection.AutoFill Destination:=Range("N2:N5000"), Type:=xlFillDefault
    Range("N2:N5000").Select
    ActiveWindow.ScrollRow = 1165
    ActiveWindow.ScrollRow = 1162
    ActiveWindow.ScrollRow = 1159
    ActiveWindow.ScrollRow = 1157
    ActiveWindow.ScrollRow = 1152
    ActiveWindow.ScrollRow = 1149
    ActiveWindow.ScrollRow = 1144
    ActiveWindow.ScrollRow = 1138
    ActiveWindow.ScrollRow = 1132
    ActiveWindow.ScrollRow = 1127
    ActiveWindow.ScrollRow = 1121
    ActiveWindow.ScrollRow = 1111
    ActiveWindow.ScrollRow = 1083
    ActiveWindow.ScrollRow = 1064
    ActiveWindow.ScrollRow = 1058
    ActiveWindow.ScrollRow = 1050
    ActiveWindow.ScrollRow = 1039
    ActiveWindow.ScrollRow = 1029
    ActiveWindow.ScrollRow = 965
    ActiveWindow.ScrollRow = 955
    ActiveWindow.ScrollRow = 941
    ActiveWindow.ScrollRow = 897
    ActiveWindow.ScrollRow = 886
    ActiveWindow.ScrollRow = 881
    ActiveWindow.ScrollRow = 875
    ActiveWindow.ScrollRow = 840
    ActiveWindow.ScrollRow = 832
    ActiveWindow.ScrollRow = 825
    ActiveWindow.ScrollRow = 814
    ActiveWindow.ScrollRow = 762
    ActiveWindow.ScrollRow = 754
    ActiveWindow.ScrollRow = 743
    ActiveWindow.ScrollRow = 733
    ActiveWindow.ScrollRow = 706
    ActiveWindow.ScrollRow = 700
    ActiveWindow.ScrollRow = 692
    ActiveWindow.ScrollRow = 684
    ActiveWindow.ScrollRow = 675
    ActiveWindow.ScrollRow = 639
    ActiveWindow.ScrollRow = 631
    ActiveWindow.ScrollRow = 624
    ActiveWindow.ScrollRow = 618
    ActiveWindow.ScrollRow = 610
    ActiveWindow.ScrollRow = 598
    ActiveWindow.ScrollRow = 593
    ActiveWindow.ScrollRow = 587
    ActiveWindow.ScrollRow = 580
    ActiveWindow.ScrollRow = 576
    ActiveWindow.ScrollRow = 569
    ActiveWindow.ScrollRow = 565
    ActiveWindow.ScrollRow = 560
    ActiveWindow.ScrollRow = 554
    ActiveWindow.ScrollRow = 541
    ActiveWindow.ScrollRow = 535
    ActiveWindow.ScrollRow = 530
    ActiveWindow.ScrollRow = 520
    ActiveWindow.ScrollRow = 516
    ActiveWindow.ScrollRow = 506
    ActiveWindow.ScrollRow = 443
    ActiveWindow.ScrollRow = 432
    ActiveWindow.ScrollRow = 423
    ActiveWindow.ScrollRow = 412
    ActiveWindow.ScrollRow = 342
    ActiveWindow.ScrollRow = 331
    ActiveWindow.ScrollRow = 309
    ActiveWindow.ScrollRow = 301
    ActiveWindow.ScrollRow = 257
    ActiveWindow.ScrollRow = 249
    ActiveWindow.ScrollRow = 243
    ActiveWindow.ScrollRow = 212
    ActiveWindow.ScrollRow = 207
    ActiveWindow.ScrollRow = 201
    ActiveWindow.ScrollRow = 194
    ActiveWindow.ScrollRow = 190
    ActiveWindow.ScrollRow = 186
    ActiveWindow.ScrollRow = 182
    ActiveWindow.ScrollRow = 177
    ActiveWindow.ScrollRow = 164
    ActiveWindow.ScrollRow = 160
    ActiveWindow.ScrollRow = 155
    ActiveWindow.ScrollRow = 152
    ActiveWindow.ScrollRow = 147
    ActiveWindow.ScrollRow = 144
    ActiveWindow.ScrollRow = 139
    ActiveWindow.ScrollRow = 136
    ActiveWindow.ScrollRow = 131
    ActiveWindow.ScrollRow = 130
    ActiveWindow.ScrollRow = 125
    ActiveWindow.ScrollRow = 117
    ActiveWindow.ScrollRow = 116
    ActiveWindow.ScrollRow = 112
    ActiveWindow.ScrollRow = 108
    ActiveWindow.ScrollRow = 106
    ActiveWindow.ScrollRow = 103
    ActiveWindow.ScrollRow = 101
    ActiveWindow.ScrollRow = 100
    ActiveWindow.ScrollRow = 97
    ActiveWindow.ScrollRow = 93
    ActiveWindow.ScrollRow = 90
    ActiveWindow.ScrollRow = 89
    ActiveWindow.ScrollRow = 87
    ActiveWindow.ScrollRow = 84
    ActiveWindow.ScrollRow = 81
    ActiveWindow.ScrollRow = 79
    ActiveWindow.ScrollRow = 78
    ActiveWindow.ScrollRow = 76
    ActiveWindow.ScrollRow = 75
    ActiveWindow.ScrollRow = 73
    ActiveWindow.ScrollRow = 71
    ActiveWindow.ScrollRow = 70
    ActiveWindow.ScrollRow = 68
    ActiveWindow.ScrollRow = 67
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 64
    ActiveWindow.ScrollRow = 62
    ActiveWindow.ScrollRow = 60
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 56
    ActiveWindow.ScrollRow = 53
    ActiveWindow.ScrollRow = 51
    ActiveWindow.ScrollRow = 49
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 29
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("N1").Select
    Columns("N:N").ColumnWidth = 15.56
    Columns("N:N").EntireColumn.AutoFit
    Columns("N:N").Select
    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 Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B1").Select
    ActiveWindow.ScrollColumn = 1
    Columns("A:A").ColumnWidth = 9
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P"
        .LeftMargin = Application.InchesToPoints(0.1)
        .RightMargin = Application.InchesToPoints(0.1)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 95
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    Columns("I:I").Select
    Selection.EntireColumn.Hidden = True
    Columns("K:K").Select
    Selection.EntireColumn.Hidden = True
    Columns("M:M").Select
    Selection.EntireColumn.Hidden = True
    Range("O2:O5000").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("O:O").ColumnWidth = 22.89
    Range("O9").Select
    Columns("F:F").ColumnWidth = 0
    Columns("E:E").ColumnWidth = 24.78
    Columns("C:C").ColumnWidth = 30.11
    Columns("F:F").ColumnWidth = 0
    Columns("E:E").ColumnWidth = 22.78
    Columns("O:O").ColumnWidth = 21.44
    Columns("O:O").ColumnWidth = 20.11
    Columns("C:C").ColumnWidth = 25.78
    Cells.Select
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "L2:L5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "A2:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "C2:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ReportExpRenew").Sort
        .SetRange Range("A1:AT1200")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("E5").Select
    Columns("F:F").ColumnWidth = 0
    Columns("E:E").ColumnWidth = 19.89
    Columns("B:B").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B1").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("L:L").Select
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "L2:L5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "A2:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "C2:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ReportExpRenew").Sort
        .SetRange Range("A1:O5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.ResetAllPageBreaks
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P"
        .LeftMargin = Application.InchesToPoints(0.1)
        .RightMargin = Application.InchesToPoints(0.1)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 95
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SmallScroll Down:=-21
    ActiveSheet.ResetAllPageBreaks
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P"
        .LeftMargin = Application.InchesToPoints(0.1)
        .RightMargin = Application.InchesToPoints(0.1)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 95
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Selection.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(1), _
        Replace:=True, PageBreaks:=True, SummaryBelowData:=True
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll Down:=-21
    Cells.Select
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub
    Last edited by Paul_Hossler; 12-11-2018 at 03:07 PM.
    Reply With Quote Reply With Quote
  4. 12-11-2018, 03:10 PM #4
    Paul_Hossler
    Paul_Hossler is offline
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,724
    Location
    Welcome to the forum

    I added CODE tags around your macro to set it off -- use the [#] icon and paste the macro between

    1. The recorder records everything

    2. You can delete the ActiveWindow.ScrollRow lines

    3. You do not usually need to .Select an object in VBA the way to select the cell or row or column using the mouse

    4. There's lots of places where the same format or parameters are applied to the same object (i.e. the PageSetup's)

    5. This is just an example after deleting the obvious lines (like .ScrollRow), using With/End With to group for readability, and not selecting things that can be acted on directly

    I did not revise all (or even most) of the macro but just enough to show the concept


    Option Explicit
Sub ExpRepRev() '
' ExpRepRev Macro
' Revised exp report to add policy #, delete columns not used and format for printing by CSR, expiration date
'
' Keyboard Shortcut: Ctrl+e
'
    Rows("1:3").Delete Shift:=xlUp
    Columns("C:D").Delete Shift:=xlToLeft
    Columns("D:F").Delete Shift:=xlToLeft
    Columns("E:F").Delete Shift:=xlToLeft
    Columns("F:K").Delete Shift:=xlToLeft
    Columns("G:G").Delete Shift:=xlToLeft
    Columns("J:L").Delete Shift:=xlToLeft
    Columns("K:K").Delete Shift:=xlToLeft
    Columns("L:X").Delete Shift:=xlToLeft
    
    With Range("A1:K1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0.599963377788629
            .PatternTintAndShade = 0
        End With
    
        .Font.Bold = True
    
    End With
    
    With Cells.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
        
    With Columns("A:A")
        .ColumnWidth = 10.44
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Columns("C:C").ColumnWidth = 34.11
    
    With Columns("D:D")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Columns("E:E").ColumnWidth = 28
    
    Columns("G:G").Insert Shift:=xlToRight
    
    Range("G1").FormulaR1C1 = "Bill"
    Columns("H:H").NumberFormat = "$#,##0.00"
    
    Selection.ColumnWidth = 11.67
    Selection.ColumnWidth = 13
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Exec"
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "CSR"
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Dept."
    Range("M25").Select
    ActiveCell.FormulaR1C1 = "Small Commercial"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Bill Method'!R1C1:R5C2,2,)"
    Columns("G:G").Select
    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
    Columns("G:G").EntireColumn.AutoFit
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G5000"), Type:=xlFillDefault
    Range("G2:G5000").Select
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Exec!R1C1:R45C2,2,)"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J5000"), Type:=xlFillDefault
    Range("J2:J5000").Select
    Range("J4").Select
    Columns("J:J").ColumnWidth = 18.11
    Columns("J:J").EntireColumn.AutoFit
    Columns("J:J").Select
    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
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],CSR!R1C1:R28C2,2,)"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L5000"), Type:=xlFillDefault
    Range("L2:L5000").Select
    Columns("L:L").Select
    Columns("L:L").EntireColumn.AutoFit
    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
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Dept.!R1C1:R7C2,2,)"
    Range("N2").Select
    Selection.AutoFill Destination:=Range("N2:N5000"), Type:=xlFillDefault
    Range("N2:N5000").Select
    Range("N1").Select
    Columns("N:N").ColumnWidth = 15.56
    Columns("N:N").EntireColumn.AutoFit
    Columns("N:N").Select
    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 Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B1").Select
    ActiveWindow.ScrollColumn = 1
    Columns("A:A").ColumnWidth = 9
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P"
        .LeftMargin = Application.InchesToPoints(0.1)
        .RightMargin = Application.InchesToPoints(0.1)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 95
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    Columns("I:I").Select
    Selection.EntireColumn.Hidden = True
    Columns("K:K").Select
    Selection.EntireColumn.Hidden = True
    Columns("M:M").Select
    Selection.EntireColumn.Hidden = True
    Range("O2:O5000").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("O:O").ColumnWidth = 22.89
    Range("O9").Select
    Columns("F:F").ColumnWidth = 0
    Columns("E:E").ColumnWidth = 24.78
    Columns("C:C").ColumnWidth = 30.11
    Columns("F:F").ColumnWidth = 0
    Columns("E:E").ColumnWidth = 22.78
    Columns("O:O").ColumnWidth = 21.44
    Columns("O:O").ColumnWidth = 20.11
    Columns("C:C").ColumnWidth = 25.78
    Cells.Select
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "L2:L5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "A2:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "C2:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ReportExpRenew").Sort
        .SetRange Range("A1:AT1200")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("E5").Select
    Columns("F:F").ColumnWidth = 0
    Columns("E:E").ColumnWidth = 19.89
    Columns("B:B").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B1").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("L:L").Select
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "L2:L5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "A2:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("ReportExpRenew").Sort.SortFields.Add Key:=Range( _
        "C2:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ReportExpRenew").Sort
        .SetRange Range("A1:O5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.ResetAllPageBreaks
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P"
        .LeftMargin = Application.InchesToPoints(0.1)
        .RightMargin = Application.InchesToPoints(0.1)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 95
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SmallScroll Down:=-21
    ActiveSheet.ResetAllPageBreaks
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P"
        .LeftMargin = Application.InchesToPoints(0.1)
        .RightMargin = Application.InchesToPoints(0.1)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 95
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Selection.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(1), _
        Replace:=True, PageBreaks:=True, SummaryBelowData:=True
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll Down:=-21
    Cells.Select
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub
    Last edited by Paul_Hossler; 12-11-2018 at 03:25 PM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Forum Rules