Macro not working right

N

naushin

New Member
Joined
Mar 25, 2011
Messages
27
Hi everyone... I wonder if someone could look at my macro below... It kind-of stops working at row # 3. Is there something I am missing?

Code: 
Sub Weekly_Projects_Report()
' This Macro is used for formatting the weekly projects status report.
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1:O1").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.349986266670736
        .PatternTintAndShade = 0
    End With
    With Range("A1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    End With
    With Columns("K:M").Select
    Selection.Style = "Currency"
      End With
ActiveSheet.Range(Range("A1"), Range("O1").End(xlDown).Offset(0, 1)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
 With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.6)
        .BottomMargin = Application.InchesToPoints(0.6)
        .HeaderMargin = Application.InchesToPoints(0.25)
        .FooterMargin = Application.InchesToPoints(0.25)
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With
    Range("A1").Select
    Columns("A:A").ColumnWidth = 12
    Columns("B:B").ColumnWidth = 20.5
    Columns("C:C").ColumnWidth = 16.5
    Columns("I:I").ColumnWidth = 16.5
    Columns("J:J").ColumnWidth = 15.5
    Columns("K:K").ColumnWidth = 14.5
    Columns("L:L").ColumnWidth = 13
    Columns("M:M").ColumnWidth = 12
    Columns("N:N").ColumnWidth = 9.15
    Cells.Select
    Cells.EntireRow.AutoFit
ActiveSheet.Range(Range("A1"), Range("O1").End(xlDown).Offset(0, 1)).Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
ActiveSheet.Range(Range("A1"), Range("O1").End(xlDown).Offset(0, 1)).Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "Pending Projects Report As Of: &D"
        .RightHeader = ""
        .LeftFooter = "&BCitigroup Confidential&B"
        .CenterFooter = "&D"
        .RightFooter = "Page &P"
    End With
    Rows("1:1").Select
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
 With ActiveWorkbook.Worksheets("Search Projects")
        .Range("A1").CurrentRegion.Sort Key1:=.Range("I2"), Order1:=xlAscending, Key2:=.Range("N2") _
            , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
            , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
         xlSortNormal
    End With
With Sheets("Search Projects").Select
Columns("D").EntireColumn.Hidden = True
Columns("E").EntireColumn.Hidden = True
Columns("F").EntireColumn.Hidden = True
Columns("G").EntireColumn.Hidden = True
Columns("H").EntireColumn.Hidden = True
Columns("O").EntireColumn.Hidden = True
Columns("P").Delete
End With
Sheets("Search Projects").Select
Sheets("Search Projects").Copy Before:=Sheets(1)
Sheets("Search Projects (2)").Name = "Completed"
Sheets("Completed").Tab.ColorIndex = 39
Sheets("Completed").Select
For i = LR To 2 Step -1
If Range("N" & i).Value = "Draft" Then
        Rows(i).Delete
        End If
If Range("N" & i).Value = "In Progress" Then
        Rows(i).Delete
        End If
If Range("N" & i).Value = "On Hold" Then
        Rows(i).Delete
        End If
If Range("N" & i).Value = "Next Year Plan" Then
        Rows(i).Delete
        End If
If Range("N" & i).Value = "Not Started" Then
        Rows(i).Delete
        End If
    Next i
Sheets("Search Projects").Select
For i = LR To 2 Step -1
If Range("N" & i).Value = "Complete" Then
        Rows(i).Delete
        End If
    Next i
Sheets("Search Projects").Name = "Pending"
With ActiveWorkbook.Sheets("Pending").Tab
        .Color = 5296274
        .TintAndShade = 0
    End With
End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
The macro does everything - except the formatting from row # 3 down to the last row in the report. (change font, size, borders, wrap text etc)
 
Upvote 0
The way you referenced the ranges for the formatting wasn't right. It was trying to look at two individual ranges. Try the following cleaned up code:

Code: 
Sub Weekly_Projects_Report()
' This Macro is used for formatting the weekly projects status report.
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
    With Range("A1:O1")
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.349986266670736
            .PatternTintAndShade = 0
        End With
    End With
    With Range("A1")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
    End With
    Columns("K:M").Style = "Currency"
With Range("A1:O" & LR)
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=xlAutomatic
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End With
With ActiveSheet.PageSetup
    .PrintTitleRows = "$1:$1"
    .PrintTitleColumns = ""
    .PrintArea = ""
    .LeftMargin = Application.InchesToPoints(0.25)
    .RightMargin = Application.InchesToPoints(0.25)
    .TopMargin = Application.InchesToPoints(0.6)
    .BottomMargin = Application.InchesToPoints(0.6)
    .HeaderMargin = Application.InchesToPoints(0.25)
    .FooterMargin = Application.InchesToPoints(0.25)
    .Orientation = xlLandscape
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Zoom = 100
    .PrintErrors = xlPrintErrorsDisplayed
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .ScaleWithDocHeaderFooter = True
    .AlignMarginsHeaderFooter = True
    .LeftHeader = ""
    .CenterHeader = "Pending Projects Report as of: &D"
    .RightHeader = ""
    .LeftFooter = "&BCitigroup Confidential&B"
    .CenterFooter = "&D"
    .RightFooter = "Page &P"
End With
Columns("A:A").ColumnWidth = 12
Columns("B:B").ColumnWidth = 20.5
Columns("C:C").ColumnWidth = 16.5
Columns("I:I").ColumnWidth = 16.5
Columns("J:J").ColumnWidth = 15.5
Columns("K:K").ColumnWidth = 14.5
Columns("L:L").ColumnWidth = 13
Columns("M:M").ColumnWidth = 12
Columns("N:N").ColumnWidth = 9.15
Cells.EntireRow.AutoFit
With Range("A1:O" & LR)
    .VerticalAlignment = xlCenter
    .WrapText = True
    With .Font
        .Name = "Calibri"
        .Size = 10
    End With
End With
With ActiveWorkbook.Worksheets("Search Projects")
    .Range("A1").CurrentRegion.Sort Key1:=.Range("I2"), Order1:=xlAscending, Key2:=.Range("N2") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
End With
With Sheets("Search Projects")
    .Columns("D").EntireColumn.Hidden = True
    .Columns("E").EntireColumn.Hidden = True
    .Columns("F").EntireColumn.Hidden = True
    .Columns("G").EntireColumn.Hidden = True
    .Columns("H").EntireColumn.Hidden = True
    .Columns("O").EntireColumn.Hidden = True
    .Columns("P").Delete
End With
Sheets("Search Projects").Copy Before:=Sheets(1)
Sheets("Search Projects (2)").Name = "Completed"
Sheets("Completed").Tab.ColorIndex = 39
For i = LR To 2 Step -1
    Select Case Sheets("Completed").Range("N" & i).Value
        Case "Draft", "In Progress", "On Hold", "Next Year Plan", "Not Started"
            Rows(i).Delete
        Case Else
    End Select
    If Sheets("Search Projects").Range("N" & i).Value = "Complete" Then
        Sheets("Search Projects").Rows(i).Delete
    End If
    Next i
End With
Sheets("Search Projects").Name = "Pending"
With ActiveWorkbook.Sheets("Pending").Tab
    .Color = 5296274
    .TintAndShade = 0
End With
End Sub
 
Upvote 0
Hi Andrew,
Yes, I make sure I am in the currect worksheet. I do not get an error message, but I do see that the formatting of the worksheet stops at row # 3. I dont understand it, everything else gets done according to the macro except for the formatting!
 
Upvote 0
Hi MrKowz - Thanks :) I am going to give it a try in a few minutes :)

stnkynts - No, I don't have merged rows. The data comes directly from one of our systems into excel - unformatted.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
324
Micron
M
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
592
RoryA
RoryA
P
  • Question Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
378
6StringJazzer
6StringJazzer
G
  • Solved
Still no solution after 1 Year - Please Help
2
Replies
10
Views
796
jolivanes
jolivanes
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
1K
kerm007
K

Forum statistics

Threads
1,224,574
Messages
6,179,629
Members
452,933
Latest member
patv

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top