Attribute VB_Name = "Format_SHARES"
Dim LR As Long, ws As Worksheet, sortrange As Range, i As Integer
Dim rept, grantee, grant, aodate As String
Sub aMacro1()

If InStr(1, (Range("c1").Value), "Evaluation Report for Self-Help Technical Assistance") > 0 Then
Call SHARES

ElseIf InStr(1, (Range("a1").Value), "502 Loans Funded") > 0 Then
Call LF502

ElseIf InStr(1, (Range("a1").Value), "Borrower Funds And Equity Report") > 0 Then
Call BFE

ElseIf InStr(1, (Range("a1").Value), "Grant Construction Report") > 0 Then
Call GrantConst

ElseIf InStr(1, (Range("a1").Value), "Grant Funds for Grant") > 0 Then
Call FundsRept

ElseIf InStr(1, (Range("a1").Value), "Lot Information Report") > 0 Then
Call LotInfo

ElseIf InStr(1, (Range("a1").Value), "Borrower Demographics Report") > 0 Then
Call Demo

ElseIf InStr(1, (Range("a1").Value), "Construction Task Matrix for all Families") > 0 Then
Call CTM

End If
End Sub


Sub BFE()
' Borrower Funds & Equity Report
'02/14/2019

Dim LO As Long

'Has page already been formatted?
If InStr(1, (Range("A2").Value), "As of") = 0 Then
Exit Sub
End If

'correct misspaced colons
    Cells.Replace " : ", ": ", _
        LookAt:=xlPart, _
        MatchCase:=False, _
        SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace " :", ": "
    Range("A2").Replace ",20", ", 20"

Set ws = ActiveSheet
grantee = Range("B5").Text
grant = Range("A5").Text

'BFE
'Format header row
    Range("A2:A3").EntireRow.Insert
    Range("A1:s1").UnMerge
    Range("A1").Copy Range("a2:A3")
    Range("A1:a4").Cut Range("C1")

    
    Range("C1").Font.Size = 16
    Range("C2").Value = grantee
    Range("C2").Font.Size = 13
    Range("C3").Value = grant
    Range("C3").Font.Size = 11
    
    Range("D1:E1, K1").EntireColumn.Delete

    
'BFE
'create addl equity column
LO = ws.Range("O" _
    & Rows.Count).End(xlUp).Row
Range("O5:O" & LO).Copy Range("P5")
Range("o7:o" & LO).FormulaR1C1 _
    = "=RC[-1]-RC[-6]"

    
If InStr(1, (Range("A8").Value), "Total Families:") = 1 Then
GoTo 1
End If
    
'rearrange cells at bottom of page
Range("A" & LO).Range("a3:b4").Cut _
    Range("A" & LO).Range("O5")
Range("A" & LO).Range("a2:b2").Cut _
    Range("A" & LO).Range("J5")


'BFE
'Add Low/Very Low Section
With Range("A" & LO)
    .Range("E5").FormulaR1C1 _
        = "=Countif(R7C:R[-4]C,""Low"")"
    .Range("E6").FormulaR1C1 = _
        "=Countif(R7C:R[-5]C,""Very Low"")"
    .Range("D5").Value = _
        "Low-Income Families:"
    .Range("D6").Value = _
        "Very Low-Income Families:"
    .Range("C5:D6,I5:J5,M5:O6").Merge True
    .Range("C5:D6").Font.Bold = True
    .Range("F5").FormulaR1C1 = _
        "=RC[-1]/(RC[-1]+R[1]C[-1])"
    .Range("F6").FormulaR1C1 = _
        "=RC[-1]/(RC[-1]+R[-1]C[-1])"
    .Range("F5:F6").NumberFormat = "0%"
    .Range("E5:F6").HorizontalAlignment _
        = xlLeft
    .Range("F5:F6").Font.Italic = True
    .Range("C5:D6,I5:J5,M5:O6").HorizontalAlignment _
        = xlRight
    .Range("C5:D6,I5:J5,M5:O6").IndentLevel _
        = 1
End With



Range("A1:B1").EntireColumn.Delete

'BFE
'Format heading
'Stack column header text
    Range("d5").Value = "House-" & Chr(10) & _
        "hold" & Chr(10) & "Size"
    Range("e5").Value = _
        "Annual" & Chr(10) & "Income"
    Range("f5").Value = _
        "Adjusted" & Chr(10) & "Income"
    Range("H5").Value = _
        "Other" & Chr(10) & "Lev. Loan"
    Range("I5").Value = _
        "Deferred" & Chr(10) & "Loan"
    Range("K5").Value = _
        "Total" & Chr(10) & "Funding"
    Range("L5").Value = _
        "Appraised" & Chr(10) & "Value"
    Range("M5").Value = _
        "Borrower" & Chr(10) & "Equity"
    Range("N5").Value = _
        "Total" & Chr(10) & "Equity"
    
    Range("A1:N4").Merge True
Range("A4:N4").HorizontalAlignment = xlLeft

    
'convert column text to number format
    For i = 4 To 14
Range(Cells(7, i), _
    Cells(7, i).End(xlDown)).TextToColumns _
    Destination:=Cells(7, i), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=True, _
    FieldInfo:=Array(1, 1), _
    TrailingMinusNumbers:=True
    
Next i

Range(Range("E7:N7"), _
Range("E7:N7").End(xlDown)).NumberFormat _
= "$#,##0.00"

LR = ws.Range("A" & Rows.Count).End(xlUp).Row

'BFE
'figure averages below data columns
Dim rng1 As Range
Set rng1 = Range("c" & LR).Offset(-3, 0)
'rng1.Activate
With rng1
.Value = "Averages:"
.Font.Bold = True
.Range("b1").FormulaR1C1 = _
    "=AVERAGE(R7C:R[-2]C)"
.Range("b1").NumberFormat = "0.0"
.Range("C1:L1").FormulaR1C1 = _
    "=IF(SUM(R7C:R[-2]C)=0,0,AVERAGEIF(R7C:R[-2]C,"">0""))"
.Range("C1:L1").NumberFormat = _
    "$#,##0.00"
.Offset(0, 10).FormulaR1C1 = _
    "=IF(OR(SUM(R7C[-6]:R[-2]C[-6])=0,SUM(R7C[-1]:R[-2]C[-1])=0),""n/a"",AVERAGEIFS(R7C:R[-2]C,R7C[-6]:R[-2]C[-6],"">0"",R7C[-1]:R[-2]C[-1],"">0""))"
.Offset(0, 11).FormulaR1C1 = _
    "=IF(OR(SUM(R7C12:R[-2]C12)=0,SUM(R7C11:R[-2]C11)=0),""n/a"",AVERAGEIFS(R7C:R[-2]C,R7C12:R[-2]C12,"">0"",R7C11:R[-2]C11,"">0""))"
End With
Range(rng1, rng1.End(xlToRight)).Font.Italic = True
Range(rng1, rng1.End(xlToRight)).HorizontalAlignment _
    = xlCenter

'BFE
'Sort
Set sortrange = _
    Range(Range("A7:N7"), _
        Range("A7:N7").End(xlDown))
ws.sort.SortFields.Clear
With ws.sort
    .SortFields.Add Key:=Range("M7"), _
        Order:=xlDescending
    .SortFields.Add Key:=Range("L7"), _
        Order:=xlDescending
    .SortFields.Add Key:=Range("A7"), _
        Order:=xlAscending
        .SetRange sortrange
        .Orientation = xlTopToBottom
        .Apply
End With
GoTo format

'BFE
1:
Range("a8:b10").Cut _
    Range("C8")
Range("A1:B1").EntireColumn.Delete
Range("B8:b10").Cut Range("C8")
Range("A8:b10").Merge True
Range("A8:b10").HorizontalAlignment = xlRight
Range("A8:b10").IndentLevel = 1

'BFE
'Format heading
'Stack column header text
    Range("d5").Value = "House-" & Chr(10) & _
        "hold" & Chr(10) & "Size"
    Range("e5").Value = _
        "Annual" & Chr(10) & "Income"
    Range("f5").Value = _
        "Adjusted" & Chr(10) & "Income"
    Range("H5").Value = _
        "Other" & Chr(10) & "Lev. Loan"
    Range("I5").Value = _
        "Deferred" & Chr(10) & "Loan"
    Range("K5").Value = _
        "Total" & Chr(10) & "Funding"
    Range("L5").Value = _
        "Appraised" & Chr(10) & "Value"
    Range("M5").Value = _
        "Borrower" & Chr(10) & "Equity"
    Range("N5").Value = "Total" & Chr(10) & "Equity"
    Range("A1:N4").Merge True
Range("A4:N4").HorizontalAlignment = xlLeft

LR = ws.Range("A" & Rows.Count).End(xlUp).Row


'Format column width & row height
'BFE
format:
    Range("A1:N" & LR).Rows.AutoFit
    Range("A1:N" & LR).Columns.AutoFit
    
    If Range("B6").ColumnWidth > 22 Then
    Range("B6").ColumnWidth = 22
    End If
        
    If Range("A6").ColumnWidth > 25 Then
    Range("A6").ColumnWidth = 25
    End If
        

'BFE
'page and print setup
    With ws.PageSetup
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.3125)
        .BottomMargin = Application.InchesToPoints(0.5)
        .PrintGridlines = True
        .CenterHorizontally = True
        '.Orientation = xlLandscape
        '.PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintTitleRows = "$1:$6"
        .PrintArea = "A1:N" & LR
End With
'ws.printpreview
Range("A1").Select
End Sub


Sub SHARES()
'
' SHARES Macro
' 9/5/2018
Dim extdt, cdays, comment, revdate As Range

'Has page already been formatted?
If InStr(1, (Range("A3").Value), "As of") > 0 Then
Exit Sub
End If

Set ws = ActiveSheet

'correct misspaced colons
    Cells.Replace "  :", ": ", _
        LookAt:=xlPart, _
        MatchCase:=False, _
        SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace " : ", ": "
    Cells.Replace " :", ": "
    Range("A1").Replace ",20", ", 20"


'Format header row
Range("A1").Cut Range("A3")
    Range("A1:E3").Merge True
    Range("A1:E2").HorizontalAlignment _
        = xlCenter
    Range("A1:E1").Font.Size = 16
    Range("A2:E2").Font.Size = 13

    
'move "Extension Date" to inserted row
Set extdt = Range("F1").End(xlDown)
    extdt.Offset(2, _
        0).EntireRow.Insert
    extdt.Range("A1:B1").Cut _
        Range("F1").End(xlDown).Offset(2, -3)
    
    
    
    
'SHARES Report
'Format sig lines
Range("d500").End(xlUp).Offset(-2, _
    0).Range("a1:b3").Merge True
    

        
    
'SHARES
'Figure percentage ahead or behind
    With Range("E5").End(xlDown).Offset(4, 0)
    .FormulaR1C1 = _
        "=IF((R[-1]C[-1]/R[-1]C-1)>=0,R[-1]C[-1]/R[-1]C-1,-(R[-1]C[-1]/R[-1]C-1))"
    .NumberFormat = "0.0%"
    .Range("A1:A2").Font.FontStyle = "Italic"
    End With
    
With Range("E5").End(xlDown).Offset(5, 0)
  .FormulaR1C1 = _
     "=IF((R[-2]C[-1]/R[-2]C-1)>=0,""Ahead"",""Behind"")"
    .HorizontalAlignment = xlRight
    .VerticalAlignment = xlTop
    End With
    
'SHARES
'converts average const. days to months
Set cdays = Cells.Find(What:="6.", _
    After:=Range("A4"), _
    LookIn:=xlFormulas, _
    LookAt:=xlWhole, _
    SearchOrder:=xlByColumns, _
    SearchDirection:=xlNext, _
    MatchCase:=False, _
    SearchFormat:=False).Offset(0, 3)


    cdays.Replace _
        What:="days", _
        Replacement:="", _
        LookAt:=xlPart, _
        SearchOrder:=xlByColumns, _
        MatchCase:=False, _
        SearchFormat:=False, _
        ReplaceFormat:=False
cdays.NumberFormat = "0 ""days"""
cdays.Range("A1:B1").VerticalAlignment _
    = xlBottom
            
    With cdays.Range("B1")
    .FormulaR1C1 = "=RC[-1]/360*12"
    .NumberFormat = "or ~0.0 ""mo."""
    .Font.FontStyle = "Italic"
    End With

'SHARES report
'Figures average equity
cdays.Offset(-2, -1).Range("A1:B1").Copy _
        cdays.Offset(-1, -1)
cdays.Offset(-1, 0).FormulaR1C1 = _
        "=R[-2]C-R[-1]C"
cdays.Offset(-2, 0).Font.Underline = True
cdays.Offset(-1, 0).NumberFormat = "$#,##0.00"
cdays.Offset(-1, -1).Value _
        = "Average Borrower Equity:"
cdays.Offset(-1, -1).IndentLevel = 1
cdays.Offset(-1, -1).Range("A1:B1").Font.Italic _
        = True
cdays.EntireRow.Insert


'format review comments
sharescomment:
Set comment = _
    Cells.Find(What:="Comments By: ", _
        After:=Range("B5"), _
        LookIn:=xlFormulas, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, _
        MatchCase:=True, _
        SearchFormat:=False)
   If comment Is Nothing Then GoTo shares3

With comment
'.Select
.Range("b1").ClearContents
.Range("c1").HorizontalAlignment = xlRight
.Range("c1").InsertIndent 1
.Offset(-1, _
    -1).Range("a1:d1, a3:e3, a2:c2").Merge True
End With

GoTo sharescomment

'SHARES Report
'autofit rows and columns
shares3:
LR = ws.Range("D" & Rows.Count).End(xlUp).Row

    Range("A1:E" & LR).Rows.AutoFit
    Range("A1:E" & LR).Columns.AutoFit
    Range("A1:E" & LR).Rows.AutoFit


'Print setup
'SHARES Report
    ws.ResetAllPageBreaks
    With ws.PageSetup
        '.LeftMargin = Application.InchesToPoints(0.25)
        '.RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.5)
        '.BottomMargin = Application.InchesToPoints(0.75)
        '.CenterHorizontally = True
        .Orientation = xlPortrait
        '.PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintArea = ("A1:E" & LR)
    End With
If (ws.PageSetup.Pages.Count) > 2 Then
ws.PageSetup.FitToPagesTall = 2
End If
    
'SHARES Report
'call message box if comment exists
Set revdate = Cells.Find(What:="Review Date:", _
    After:=Range("D5"), _
    LookIn:=xlFormulas, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, _
        MatchCase:=True, _
        SearchFormat:=False)
    If revdate Is Nothing Then
        Exit Sub
    End If
revdate.Range("a2").Select
MsgBox _
    "Height of comment row(s) may need to be adjusted in order to view entire comment. (Multiples of 15 work best).", _
    vbInformation, _
    "Message JSLD1:"
End Sub

Sub GrantConst()
' GrantConstRept Macro
'02/14/2019
' Kilroy was here!
Set ws = ActiveSheet

'Has page already been formatted?
If InStr(1, (Range("a2").Value), "As of") = 0 Then
Exit Sub
End If

'correct misspaced colons
Cells.Replace " : ", ": ", _
    LookAt:=xlPart, _
    MatchCase:=False, _
    SearchFormat:=False, _
    ReplaceFormat:=False
Cells.Replace " :", ": "
Range("A2").Replace ",20", ", 20"
    
grantee = Range("B5").Text
grant = Range("A5").Text


'const
'Format header row
    Range("A2:A3").EntireRow.Insert
    Range("A1").UnMerge
    Range("A1").Copy Range("A2, A3")

    Range("A1:a4").Cut _
        Range("C1")
    
    Range("A1:B1").EntireColumn.Delete

    
'Stack text in column headers
'grant construction report
    Range("D5").Value = _
        "Pledged" & Chr(10) & "Points"
    Range("E5").Value = _
        "Construction" & Chr(10) & "Start Date"
    Range("F5").Value = _
        "Construction" & Chr(10) & "End Date"
    Range("G5").Value = _
        "Months" & Chr(10) & "Elapsed"
    Range("H5").Value = _
        "Tasks" & Chr(10) & "Comp."
    Range("I5").Value = _
        "Const." & Chr(10) & "Points"
    Range("J5").Value = "Total" & Chr(10) & "EUs"

'grant construction report
'convert column text to number format
Dim LE As Long
LE = ws.Range("E" & Rows.Count).End(xlUp).Row
LR = ws.Range("J" & Rows.Count).End(xlUp).Row

If InStr(1, (Range("e" & LE).Value), "Construction" & Chr(10) & "Start Date") = 1 Then
GoTo J7
End If


    Range("E7:E" & LE).TextToColumns _
    Destination:=Range("E7"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=True, _
    FieldInfo:=Array(1, 1), _
    TrailingMinusNumbers:=True

    Range("F7:F" & LE).TextToColumns _
    Destination:=Range("F7"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=True, _
    FieldInfo:=Array(1, 1), _
    TrailingMinusNumbers:=True


J7:
    Range("J7:J" & LR).TextToColumns _
    Destination:=Range("J7"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=True, _
    FieldInfo:=Array(1, 1), _
    TrailingMinusNumbers:=True



    
    Range("E7:F" & LR).NumberFormat _
        = "mm/dd/yyyy"
    Range("J7:j" & LR).NumberFormat _
        = "0.0##"
  

'const
'Sort
If IsEmpty(Range("a8").Value) = True Then
GoTo format
End If

Set sortrange = _
Range(Range("A7:J7"), Range("A7:J7").End(xlDown))
ws.sort.SortFields.Clear
With ws.sort
    .SortFields.Add Key:=Range("J7"), _
        Order:=xlDescending
    .SortFields.Add Key:=Range("I7"), _
        Order:=xlDescending
    .SortFields.Add Key:=Range("E7"), _
        Order:=xlAscending
    .SortFields.Add Key:=Range("A7"), _
        Order:=xlAscending
    .SetRange sortrange
    .Orientation = xlTopToBottom
    .Apply
End With

format:
Range("A1:J4").Merge True
Range("A4:J4").HorizontalAlignment = xlLeft
    Range("A1:J1").Font.Size = 16
    Range("A2:j2").Value = grantee
    Range("a2:j2").Font.Size = 13
    Range("a3:j3").Value = grant
    Range("a4:j4").Font.Size = 10
    

'Format row height and column width
    Range("A7:J" & LR).RowHeight = 15
    Range("A1:J5").Rows.AutoFit
    Range("A5:J" & LR).Columns.AutoFit
    
    If Range("A6").ColumnWidth > 25 Then
    Range("A6").ColumnWidth = 25
    End If
    
    If Range("b6").ColumnWidth > 12 Then
    Range("b6").ColumnWidth = 12
    End If
    
If Range("C6").ColumnWidth > 15 Then
    Range("C6").ColumnWidth = 15
    End If

'page and print setup
    With ws.PageSetup
        .LeftMargin = Application.InchesToPoints(0.3125)
        .RightMargin = Application.InchesToPoints(0.3125)
        .TopMargin = Application.InchesToPoints(0.3125)
        .BottomMargin = Application.InchesToPoints(0.5)
        .PrintGridlines = True
        .CenterHorizontally = True
        .Orientation = xlPortrait
        '.PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintTitleRows = "$1:$5"
        .PrintArea = "A1:J" & LR
End With
'ws.printpreview
    Range("A1").Select
'grant construction report
End Sub

Sub FundsRept()
' Format Grant Funds Report
' 8/31/18

'Have funds been used/rec'd?
If InStr(1, (Range("a4").Value), "Fund Type") > 0 Then
Call funds_new
Exit Sub
End If

'Has page already been formatted?
If Not IsEmpty(Range("a4").Value) = True Then
Exit Sub
End If

'correct misspaced colons
    Cells.Replace "  :", ": ", _
        LookAt:=xlPart, _
        MatchCase:=False, _
        SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace " :", ": "

Set ws = ActiveSheet
aodate = "As of: " & format(Now(), _
    "mmmm d, yyyy")

'Format header rows
Range("A1").UnMerge
Range("C4").Copy Range("C2")

Range("A1:D5").Merge True
Range("a4:d4").HorizontalAlignment = xlLeft
Range("A1:d1").Font.Size = 16
Range("a2:d2").Font.Size = 13
Range("a3:d3").Font.Size = 12
Range("A4").Value = aodate
Range("A4").Font.Size = 10


Cells.Find(What:="Funds Used", _
    After:=Range("A7"), _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    SearchOrder:=xlByColumns, _
    SearchDirection:=xlNext, _
    MatchCase:=True, _
    SearchFormat:=False).Activate
    
ActiveCell.Range("A1:D1").MergeCells = True
  ActiveCell.Offset(-1, 0).Range("A1:D2").EntireRow.Insert
  ActiveCell.Offset(-2, 3).Range("A1:D1").Cut _
    ActiveCell.Offset(-1, 0)
  ActiveCell.Offset(-1, 2).Range("A1:B1").Cut _
    ActiveCell.Range("A1")
  ActiveCell.Offset(-2, _
    0).Range("a1:a3").HorizontalAlignment _
        = xlRight
  ActiveCell.Offset(-2, _
    0).Range("a1:a3").IndentLevel = 1
    
'Grant funds report
Cells.Find(What:="523 Funds Used", _
    After:=ActiveCell, _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    SearchOrder:=xlByColumns, _
    SearchDirection:=xlNext, _
    MatchCase:=True, _
    SearchFormat:=False).Activate
    
    

'format funds used totals
ActiveCell.Range("F1").Font.Bold = True
ActiveCell.Range("D1:g1").Cut _
    ActiveCell.Range("A2")
ActiveCell.Range("c2:d2").Cut _
    ActiveCell.Range("A3")
ActiveCell.Range("A4").EntireRow.Cut _
    ActiveCell.Range("A5")

'ActiveCell.Range("A4").EntireRow.Insert
ActiveCell.Range("A7, A9").EntireRow.Delete

ActiveCell.Range("c8:f8").Cut _
ActiveCell.Range("A9")
ActiveCell.Range("C9:D9").Cut _
ActiveCell.Range("A10")
ActiveCell.Range("e5:f6").Cut _
ActiveCell.Range("c7")
'ActiveCell.Offset(-5, 0).Range("e1:f2").Cut
'ActiveCell.Offset(-3, 2).Activate
'ws.Paste
ActiveCell.Offset(0, _
    0).Range("a1:a10, c5:c10").HorizontalAlignment _
        = xlRight
ActiveCell.Offset(0, _
    0).Range("a1:a10, c5:c10").IndentLevel _
        = 1

'funds report
'add available funds
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
    Range("C" & LR).Value _
        = "523 Funds Available:"
    Range("D" & LR).FormulaR1C1 _
        = "=R[-5]C2-R[-4]C2-R[-2]C2"
    Range("D" & LR).NumberFormat _
        = "$#,##0.00"
    Range("D" & LR).HorizontalAlignment = _
        xlLeft
Range("e1:g1").EntireColumn.Delete

'funds report
'add border
ActiveCell.Offset(4, _
    0).Range("A1:D6").BorderAround 1, xlThick

    


'Grant Funds Report
'page and print setup
Range("A1:D5").Rows.AutoFit
Range("A6:D" & LR).RowHeight = 15
Range("A6:D" & LR).Columns.AutoFit
Range("B6").ColumnWidth = 35
    
    With ws.PageSetup

        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.3125)
        .BottomMargin = Application.InchesToPoints(0.5)
        '.PrintGridlines = True
        .CenterHorizontally = True
        .Orientation = xlPortrait
        '.PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintTitleRows = "$1:$4"
        '.PrintArea = "A1:D" & LR
    End With

'Grant Funds Report
'Enter pg break if needed
If (ws.PageSetup.Pages.Count) > 1 Then
Cells.Find(What:="Fund Type", _
    After:=Range("A7"), _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    SearchOrder:=xlByColumns, _
    SearchDirection:=xlNext, _
    MatchCase:=True, _
    SearchFormat:=False).Offset(-1, _
        0).PageBreak = _
        xlPageBreakManual
End If
    
    Range("A1:D1").Select
'Grant Funds Report
'ws.printpreview
End Sub


Sub funds_new()
'8/31/2018

If InStr(1, (Range("b4").Value), "Description") = 0 Then
Exit Sub
End If
    
Set ws = ActiveSheet
    
    Cells.Replace " : ", ": ", LookAt:=xlPart, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace " :", ": "

'funds new
'set header strings
'rept = Range("A1").Text
'grant = Range("c3").Text
aodate = "As of: " & format(Now(), "mmmm d, yyyy")
grantee = InputBox("Please enter name of grantee", "MISSING DATA", "Grantee Name")

Range("A1:G1").UnMerge
'Range("a2").EntireRow.Insert
Range("a1").EntireRow.Copy
Range("A2").Insert
'Range("A2").Select
'ws.Paste
Range("C4").Copy Range("A3")
Range("A2").Value = grantee
Range("C4").Value = aodate


Range("a1:D4").Merge True
Range("a4:d4").HorizontalAlignment = xlLeft
Range("A1:d1").Font.Size = 16
Range("a2:d2").Font.Size = 13
Range("a3:d3").Font.Size = 12
Range("a4:d4").Font.Size = 10


'funds new
'delete header rows
'Range("a1:d3").EntireRow.Delete
Cells.Find(What:="Funds Used", After:=Range("A5"), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
    
'funds new
'format funds used totals
ActiveCell.Range("F1").Font.Bold = True
ActiveCell.Range("D1:g1").Cut _
    ActiveCell.Range("A2")
ActiveCell.Range("c2:d2").Cut _
    ActiveCell.Range("A3")

'funds new
'format totals at bottom of pg
ActiveCell.Range("A4").EntireRow.Cut _
    ActiveCell.Range("A5")
ActiveCell.Range("A7, A9").EntireRow.Delete
ActiveCell.Range("c8:f8").Cut _
    ActiveCell.Range("A9")
ActiveCell.Range("c9:d9").Cut _
    ActiveCell.Range("A10")
ActiveCell.Range("e5:f6").Cut _
    ActiveCell.Range("C7")
ActiveCell.Range("a1:a10, c5:c10").HorizontalAlignment _
    = xlRight
ActiveCell.Range("a1:a10, c5:c10").IndentLevel _
    = 1

'funds new
'add available funds
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
    Range("C" & LR).Value = "523 Funds Available:"
    Range("D" & LR).FormulaR1C1 = _
        "=R[-5]C2-R[-4]C2-R[-2]C2"
    Range("D" & LR).NumberFormat = "$#,##0.00"
    Range("D" & LR).HorizontalAlignment = xlLeft
    'Range("C" & LR, "D" & LR).Select
Range("e1:g1").EntireColumn.Delete
        

'funds new
'add border
ActiveCell.Range("A5:D10").BorderAround _
    1, xlThick
    
'funds new
'format rows/columns
        Range("A1:d4").Rows.AutoFit
        Range("A5:D5").RowHeight = 30
        Range("A6:D" & LR).RowHeight = 15
Range("A5:D" & LR).Columns.AutoFit
    'Range("A1:d2").Rows.AutoFit
    'Range("A1:D" & LR).Columns.AutoFit
    
    If Range("B6").ColumnWidth < 35 Then
    Range("B6").ColumnWidth = 35
    End If
    
'Range("e1:g1").EntireColumn.Delete

'Grant Funds Report
'page and print setup
    With ws.PageSetup

        '.LeftMargin = Application.InchesToPoints(0.25)
        '.RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        '.BottomMargin = Application.InchesToPoints(0.3125)
        '.PrintGridlines = True
        .CenterHorizontally = True
        .Orientation = xlPortrait
        '.PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        '.PrintTitleRows = "$1:$1"
        .PrintArea = "A1:D" & LR
    End With

'Grant Funds Report
    Range("A1:D1").Select

End Sub

Sub LF502()


' Format 502 Loans Funded report
'
Dim tot As Range
Set ws = ActiveSheet

'Has page already been formatted?
If InStr(1, (Range("a2").Value), "As of") _
= 0 Then
Exit Sub
End If

'correct misspaced colons
Cells.Replace " : ", ": ", _
    LookAt:=xlPart, _
    MatchCase:=False, _
    SearchFormat:=False, _
    ReplaceFormat:=False
Range("A2").Replace ",20", ", 20"


'rept = Range("A1").Text
grantee = Range("B5").Text
grant = Range("A5").Text
'aodate = Range("A2").Text

'Format header row
    Range("A1").UnMerge
    Range("A2:A3").EntireRow.Insert
    Range("A4").Copy Range("A2, A3")
    'Range("a2").Select
    'ws.Paste
    'Range("a3").Activate
    'ws.Paste
    Range("A1:a4").Cut Range("D1")
    
'502
'Add column for Borrower Equity
    Range("G1:H1").EntireColumn.Cut
    'Columns("G:H").Cut
    Range("L1").Insert Shift:=xlToRight
    Range("k1").EntireColumn.Copy Range("L1")
    'Range("L1").Select
    'ws.Paste
        
Set tot = Cells.Find(What:="Totals: ", _
        After:=Range("B7"), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, _
        MatchCase:=True, _
        SearchFormat:=False)
    tot.Range("A1:A4").Cut tot.Range("E1")
    'ActiveCell.Offset(0, 4).Select
    'ws.Paste
    
'Delete columns and stack column header text
'502 Loans Funded
LF1:
    Range("A1:c1").EntireColumn.Delete
    tot.Offset(-2, _
        0).Range("A1:A2, A4:A5").EntireRow.Delete
    
    Range("A5").Value = "Borrower " & Chr(10) & "Name"
    Range("C5").Value = "Loan " & Chr(10) & "Closed On"
    Range("G5").Value = "Appraised " & Chr(10) & "Value"
    Range("H5").Value = "Borrower" & Chr(10) & "Equity"
    Range("I5").Value = "Total" & Chr(10) & "Equity"



'502 Loans Funded
'convert column text to numbers
If IsEmpty(Range("F8").Value) = True Then
LR = ws.Range("I" & Rows.Count).End(xlUp).Row
GoTo hdr
End If
    For i = 4 To 9
Range(Cells(7, i), Cells(7, _
        i).End(xlDown)).TextToColumns _
    Destination:=Cells(7, i), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=True, _
    FieldInfo:=Array(1, 1), _
    TrailingMinusNumbers:=True
    
Next i

Range(Range("D7:I7"), _
Range("D7:I7").End(xlDown)).NumberFormat _
= "$#,##0.00"


'502 Loans Funded
'insert formulas
With tot
    .Range("f1").FormulaR1C1 = _
        "=SUM(R7C:R[-2]C)"
    .Range("f2").FormulaR1C1 = _
        "=AVERAGE(R7C:R[-3]C)"
    .Range("b3:e3").FormulaR1C1 _
    = "=IF(SUM(R7C:R[-4]C)=0,0,AVERAGEIF(R7C:R[-4]C,"">0""))"
    
    .Range("F3").FormulaR1C1 = _
        "=IF(OR(SUM(R7C[-4]:R[-4]C[-4])=0,SUM(R7C[-1]:R[-4]C[-1])=0),""n/a"",AVERAGEIFS(R7C:R[-4]C,R7C[-4]:R[-4]C[-4],"">0"",R7C[-1]:R[-4]C[-1],"">0""))"
    .Range("G3").FormulaR1C1 = _
        "=IF(OR(SUM(R7C[-3]:R[-4]C[-3])=0,SUM(R7C[-2]:R[-4]C[-2])=0),""n/a"",AVERAGEIFS(R7C:R[-4]C,R7C[-3]:R[-4]C[-3],"">0"",R7C[-2]:R[-4]C[-2],"">0""))"
    .Range("b3:g3").NumberFormat _
        = "$#,##0.00"
    
    .Range("A3:G3").Font.Italic = True
    .Range("A3:G3").HorizontalAlignment _
        = xlCenter
End With
    
    Range(Range("H7"), _
        Range("H7").End(xlDown)).FormulaR1C1 = _
           "=RC[-1]-RC[-4]"
    

'502 Loans Funded
LR = ws.Range("I" & Rows.Count).End(xlUp).Row

'Data sorting
Set sortrange = _
    Range(Range("A7:I7"), _
        Range("A7:I7").End(xlDown))
ws.sort.SortFields.Clear
With ws.sort
    .SortFields.Add Key:=Range("H7"), _
        Order:=xlDescending
    .SortFields.Add Key:=Range("G7"), _
        Order:=xlDescending
    .SortFields.Add Key:=Range("A7"), _
        Order:=xlAscending
        .SetRange sortrange
        .Orientation = xlTopToBottom
        .Apply
End With

With Range("B" & LR)
.Range("a1:b1").Merge
.Value = "Adj. Averages:"
.HorizontalAlignment = xlRight
.Font.Italic = True
End With

hdr:
Range("A1:I4").Merge True
Range("a4:I4").HorizontalAlignment = xlLeft
Range("A1:I1").Font.Size = 16
Range("a2:I2").Font.Size = 13
Range("a3:I3").Font.Size = 12
Range("a4:I4").Font.Size = 10
Range("A2").Value = grantee
Range("A3").Value = grant
    
    
'502
'Format Row/Column Sizes
    Range("A6:I" & LR).Rows.RowHeight = 15
    Range("A5:I" & LR).Columns.AutoFit
    Range("A1:I6").Rows.AutoFit
    
    If Range("B3").ColumnWidth > 13 Then
    Range("B3").ColumnWidth = 13
    End If

    If Range("a6").ColumnWidth > 24 Then
    Range("a6").ColumnWidth = 24
    End If


'502
tot.Range("A1:A3").HorizontalAlignment _
        = xlRight
'Range("C" & LR).Offset(-2, _
    0).Range("A1:A3").IndentLevel = 1


'502 Loans Funded
'page and print setup
    With ws.PageSetup
    .LeftMargin = Application.InchesToPoints(0.3125)
    .RightMargin = Application.InchesToPoints(0.3125)
    .TopMargin = Application.InchesToPoints(0.3125)
    .BottomMargin = Application.InchesToPoints(0.3125)
        '.PrintGridlines = True
        .CenterHorizontally = True
        .Orientation = xlPortrait
        '.PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintTitleRows = "$1:$6"
        .PrintArea = "A1:I" & LR
    End With
Range("A1").Select
'ws.printpreview
    
End Sub



Sub LotInfo()
'
' LotInfoRept Macro
' 9/5/2018
Dim tnol As Range
Set ws = ActiveSheet

'Has page already been formatted?
If InStr(1, (Range("a2").Value), _
    "As of") = 0 Then
Exit Sub
End If

'correct misplaced colons
    Cells.Replace " : ", ": ", _
        LookAt:=xlPart, _
        MatchCase:=False, _
        SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace " :", ":"
    Range("A2").Replace ",20", ", 20"


Range("A1").UnMerge
Range("A2").Cut _
    Range("A4")
Range("C5").Cut _
    Range("a2")
Range("C4").Cut _
    Range("a3")

On Error GoTo hdr

'rearrange bottom page totals
'lot info report
Set tnol = Range("a500").End(xlUp)
    tnol.Range("C1:F1").Cut tnol.Range("A2")
    tnol.Range("c2:d2").Cut tnol.Range("A3")
    tnol.Range("A1:B3").Cut tnol.Range("C1")
    'ActiveCell.Offset(-2, 2).Select
    
    
'tnol.Select
tnol.Offset(0, -2).Range("A1:C3").Merge True
'tnol.Range("a1:c3").Merge True
tnol.Range("A1:C3").HorizontalAlignment _
    = xlRight
'.IndentLevel = 1 (don't change it!!!)
    
        
'Deleting unwanted columns
'lot info report
    Range("I1:J1").EntireColumn.Delete
    
    'stacking text
    Range("e6").Value = "Borrower " & Chr(10) _
                        & "Assigned"
    Range("f6").Value = "Lot " & Chr(10) _
                        & "Area"
    Range("h6").Value = "Devel. " & Chr(10) _
                        & "Fees"
    
'Lots Rept
'Convert col to text
    Range(Range("G7"), _
    Range("G7").End(xlDown)).TextToColumns _
    Destination:=Range("G7"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=True, _
    FieldInfo:=Array(1, 1), _
    TrailingMinusNumbers:=True
    
    Range(Range("H7"), _
    Range("H7").End(xlDown)).TextToColumns _
    Destination:=Range("H7"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=True, _
    FieldInfo:=Array(1, 1), _
    TrailingMinusNumbers:=True

    Range(Range("G7:H7"), _
      Range("G7:H7").End(xlDown)).NumberFormat _
        = "$#,##0.00"

'Lots
'Data sorting
Set sortrange = _
    Range(Range("A7:H7"), _
        Range("A7:H7").End(xlDown))
ws.sort.SortFields.Clear
With ws.sort
    .SortFields.Add Key:=Range("B7"), _
        Order:=xlAscending, CustomOrder:= _
        "Purchased,Borrower Owned,Option to Purchase,Available", _
        DataOption:=xlSortNormal
    .SortFields.Add Key:=Range("E7"), _
        Order:=xlAscending
        .SetRange sortrange
        .Orientation = xlTopToBottom
        .Apply
End With
    
'Enter averages
Set rnew = Range("F7").End(xlDown).Offset(2, -1)
    
'rnew.Select
rnew.Value = "Averages:"
rnew.HorizontalAlignment = xlRight
rnew.IndentLevel = 1
rnew.Range("B1:D1").FormulaR1C1 = _
    "=IF(SUM(R7C:R[-2]C)=0,0,AVERAGEIF(R7C:R[-2]C,"">0""))"
rnew.Range("B1").NumberFormat = _
    "#,##0"" SF"""
With rnew.Range("B2")
.FormulaR1C1 = "=R[-1]C/43560"
.NumberFormat = "0.0"" Ac."""
End With

rnew.Range("C1:D1").NumberFormat = _
    "$#,##0.00"
rnew.Range("B1:D2").HorizontalAlignment _
    = xlLeft
rnew.Range("A1:D2").Font.Italic = True
    
    
hdr:
Range("A1:H4").Merge True
Range("A4:H4").HorizontalAlignment = xlLeft
    Range("A1:h1").Font.Size = 16
    Range("a2:H2").Font.Size = 13
    Range("A4:H4").Font.Size = 10
Range("A5").EntireRow.Delete

    'formatting column widths and row heights
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
    With Range("D6:D" & LR)
    '.Select
        .HorizontalAlignment = xlRight
        .WrapText = False
        .IndentLevel = 1
    End With

'Shift this
Range("D" & LR).Offset(-2, _
    0).Range("a1:a3").HorizontalAlignment _
        = xlLeft

    Range("A6:H" & LR).RowHeight = 15
    Range("A1:H" & LR).Columns.AutoFit
    Range("A1:H5").Rows.AutoFit
    
        
    If Range("A4").ColumnWidth > 12 Then
    Range("a4").ColumnWidth = 12
    End If

    If Range("B4").ColumnWidth > 11 Then
    Range("B4").ColumnWidth = 11
    End If
    
    If Range("C4").ColumnWidth > 35 Then
    Range("C4").ColumnWidth = 35
    End If
    
    If Range("D4").ColumnWidth > 35 Then
    Range("D4").ColumnWidth = 35
    End If
    
    If Range("E4").ColumnWidth > 25 Then
    Range("e4").ColumnWidth = 25
    End If


'Lot Info Report
'page and print setup
    With ws.PageSetup

        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.3125)
        .BottomMargin = Application.InchesToPoints(0.5)
        '.PrintGridlines = True
        '.CenterHorizontally = True
        '.Orientation = xlLandscape
        '.PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        '.PrintErrors = xlPrintErrorsDisplayed
        .PrintTitleRows = "$1:$5"
        .PrintArea = "A1:H" & LR
    End With

    Range("A1").Select
    'ws.printpreview
'lot info report
End Sub



Sub Demo()
' Borrower Demographics Report
'9/5/2018
Set ws = ActiveSheet

'Has page already been formatted?
If InStr(1, (Range("A2").Value), "As of") = 0 Then
Exit Sub
End If

Dim Msg, Style, Title, Response
Msg = "Is legal size paper (8.5 x 14) loaded? Click ""No"" to use standard letter-size (8.5 x 11) paper."
Style = vbYesNo + vbInformation
Title = "Specify Paper Size"

'correct misplaced colons
    Cells.Replace " : ", ": ", LookAt:=xlPart, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace " :", ":"
    Range("A2").Replace ",20", ", 20"
    Cells.Replace What:="Living With Family", Replacement:="With Family", LookAt:=xlWhole, MatchCase:=True
    Cells.Replace "Manufactured/Mobile", "Mobile/Manuf"


rept = Range("A1").Text
grantee = Range("A5").Text
grant = Range("A4").Text
aodate = Range("A2").Text

'
' Delete header rows
' Borrower Demo Rept
Range("a1:a5").EntireRow.Delete
    
'Merge/Format Totals cells
'Borrower Demo Rept
Dim loinc As Range
Set loinc = Range("a500").End(xlUp).Offset(-5, 0)

loinc.Range("B1:B6").TextToColumns _
    Destination:=loinc.Range("B1:B6"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=True, _
    FieldInfo:=Array(1, 1), _
    TrailingMinusNumbers:=True

loinc.Range("a5:b6").Cut _
    loinc.Range("r1")
loinc.Range("a3:b4").Cut _
    loinc.Range("h1")
loinc.Range("b1:b2").Cut _
loinc.Range("c1")

With loinc.Range("A1:B2, F1:H2, O1:R2")
.Merge True
.HorizontalAlignment = xlRight
.IndentLevel = 1
End With


'Borrower Demo Rept
'Stack text
    Range("B1").Value = _
        "Borrower " & Chr(10) & "Group"
    Range("D1").Value = _
        "Docket " & Chr(10) & "Status"
    Range("E1").Value = _
        "Docket " & Chr(10) & "Status Date"
    Range("I1").Value = _
        "House-" & Chr(10) & "hold" & Chr(10) & "Size"
    Range("J1").Value = _
        "Type of " & Chr(10) & "Dwelling"
    Range("M1").Value = _
        "Deficient " & Chr(10) & "Housing"
    Range("N1").Value = _
        "502 " & Chr(10) & "Account"
    Range("O1").Value = _
        "Cong." & Chr(10) & "District"
    Range("R1").Value = _
        "Marital " & Chr(10) & "Status"
    Range("S1").Value = _
        "Energy " & Chr(10) & _
        "Efficiency " & Chr(10) & _
        "Req."

'Borrower Demo Rept
'page and print setup
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
        Range("A1:S" & LR).RowHeight = 15
        Range("A1:S" & LR).Columns.AutoFit
        Range("A1:S" & LR).Rows.AutoFit

    If Range("A1").ColumnWidth > 25 Then
    Range("A4").ColumnWidth = 25
    End If
    
    If Range("B1").ColumnWidth > 14 Then
    Range("B4").ColumnWidth = 14
    End If
    
    If Range("c1").ColumnWidth > 18 Then
    Range("c4").ColumnWidth = 18
    End If
    
    If Range("H1").ColumnWidth > 20 Then
    Range("H4").ColumnWidth = 20
    End If

    If Range("P1").ColumnWidth > 17 Then
    Range("P1").ColumnWidth = 17
    End If

Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then
GoTo fmtltr
End If


'borrower demo
'format for legal-size paper
    With ws.PageSetup
        .LeftHeader = "" & Chr(10) & "" _
            & Chr(10) & "" & Chr(10) & "" & Chr(10) _
            & "&""Calibri,Bold""&9" & aodate
        .CenterHeader = _
                "&""Calibri,Bold""&16" & rept & Chr(10) _
                & "&13" & grantee & Chr(10) _
                & "&10" & " " & grant
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(1.125)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.25)
        '.PrintGridlines = True
        '.CenterHorizontally = True
        '.Orientation = xlLandscape
        .PaperSize = xlPaperLegal
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .ScaleWithDocHeaderFooter = False
        .PrintTitleRows = "$1:$1"
        .PrintArea = "A1:S" & LR
    End With
Range("A1").Select
Exit Sub


fmtltr:
'borrower demo
'format for letter-size paper
ws.VPageBreaks.Add Before:=Range("J1:J2")
    With ws.PageSetup
        .LeftHeader = "" & Chr(10) & "" _
            & Chr(10) & "" & Chr(10) & "" & Chr(10) _
            & "&""Calibri,Bold""&9" & aodate
        .CenterHeader = _
                "&""Calibri,Bold""&16" & rept & Chr(10) _
                & "&13" & grantee & Chr(10) _
                & "&10" & " " & grant
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(1.125)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.25)
        '.PrintGridlines = True
        .CenterHorizontally = True
        .Orientation = xlPortrait
        '.PaperSize = xlPaperLetter
        .Order = xlOverThenDown
        .Zoom = 85
        '.FitToPagesWide = False
        '.FitToPagesTall = False
        .ScaleWithDocHeaderFooter = False
        .PrintTitleRows = "$1:$1"
        .PrintArea = "A1:S" & LR
    End With

Range("a1").Select
Exit Sub
End Sub


Sub CTM()
'9/7/2018
Dim upcell, dncell, b01, pivot As Range
Dim n, c, z, r As Integer

Set ws = ActiveSheet
If InStr(1, (Range("A2").Value), "As of") = 0 Then
Exit Sub
End If

'CTM
'******1. Rearrange header area***************
Range("A1:A5").UnMerge

'correct misspaced colons
Range("A6").Replace "  :", ": ", _
   LookAt:=xlPart, _
   MatchCase:=False, _
   SearchFormat:=False, _
   ReplaceFormat:=False
Cells.Replace " : ", ": "
Cells.Replace " :", ": "

Range("A5").Replace "Grantee: ", ""
Range("A4").Replace "Grant Name: ", ""
Range("A2").Replace ",20", ", 20"


Range("A5").Cut Range("A3")
Range("A2").Cut Range("A5")
Range("A3:A5").Cut Range("A2")
Range("A5").EntireRow.Delete


Range("A1:m4").Merge True
Range("A1:m3").HorizontalAlignment = xlCenter

    Range("A1:m1").Font.Size = 16
    Range("a2:m2").Font.Size = 13
    Range("A3:m3").Font.Size = 12
    Range("A4:M4").Font.Size = 10



'ctm
'*******2. determine if new page/style exists;
'          cut/paste to end of calc page
z = 5
2:
Set pivot = Cells(z, 1)
'pivot.Select 'temporary
Set b01 = pivot.Range("D2")
z = z + 32

Line2a:
'Cell contains "3"...
'Cells(z, 1).Select 'temporary
c = 10
Do While InStr(1, (Cells(z, 1).Value), "3") > 0
Set upcell = Cells(z, 1)
'upcell.Select 'temporary
upcell.Offset(-3, 3).Range("a1:j28").Cut _
    b01.Offset(0, c)
z = z + 28
c = c + 10
Loop


'If not "3", does prev cell contain "As of"?
'Cells(z, 1).Select 'temporary
If InStr(1, _
    (Cells(z - 1, 1).Value), _
            "As of") > 0 Then
    z = z + 32
    GoTo Line2a
    'Else
    End If
    'GoTo 3

'ctm
'**********3. Figure const pts and sort

'Does page contain more than one borrower?
If Not IsEmpty(b01.Range("B1").Value) _
    = True Then

'insert row
b01.Range("A28").EntireRow.Copy
b01.Offset(28, -3).Insert
Range(b01.Range("A29"), _
    b01.Range("A29").End(xlToRight)).FormulaR1C1 = _
    "=SUMIF(R[-27]C:R[-1]C,""*20*"",R[-27]C3:R[-1]C3)"



'ctm
'Sort
Set sortrange = Range(b01.Range("A1:A29"), _
    b01.Range("A1:A29").End(xlToRight))
ws.sort.SortFields.Clear
With ws.sort
.SortFields.Add Key:=b01.Offset(28, 0), _
    Order:=xlDescending
     .SortFields.Add Key:=b01, _
     Order:=xlAscending
     .SetRange sortrange
     .Orientation = xlLeftToRight
     .Apply
End With
b01.Range("A29").EntireRow.Delete


ElseIf IsEmpty(Cells(z, 1)) Then
GoTo 5
'Cells(z, 1).Select 'temporary
Else
Cells(z - 1, 1).UnMerge
Cells(z - 1, 1).Value = "As of"
GoTo 2
End If

'ctm2
'**********4. reconfigure data pages

r = 33
n = 10
'Cell contains "3"?
Do While InStr(1, (pivot.Cells(r, _
    1).Value), "3") > 0
Set dncell = pivot.Cells(r, 1)
'dncell.Select 'temporary
b01.Offset(0, n).Range("a1:j28").Cut _
    dncell.Offset(-3, 3)
r = r + 28
n = n + 10
Loop


'Cell doesn't contain "3"
If InStr(1, (pivot.Cells(r, _
    1).Value), "Type") > 0 Then
'pivot.Cells(r, 1).Select 'temporary
pivot.Cells(r - 1, 1).UnMerge
pivot.Cells(r - 1, 1).Value = "As of"
GoTo 2
End If

'ctm
'**********5. Insert page breaks and page setup
5:
If Cells.Find(What:="As of", _
    After:=Range("C7"), _
    LookIn:=xlFormulas, _
    LookAt:=xlWhole, _
    SearchOrder:=xlByColumns, _
    SearchDirection:=xlNext, _
    MatchCase:=False, _
    SearchFormat:=False) Is Nothing Then

GoTo LineCTMsing
End If


'Else...---->
'CTMmult
ws.PageSetup.PrintTitleRows = "$1:$4"
r = 37

LineCTMmult:
'Insert const type and pg breaks
'Does cell contain "3"?
'Cells(r, 1).Select 'temporary
Do While InStr(1, (Cells(r, 1).Value), "3") > 0
    Cells(r - 32, 1).EntireRow.Copy
'Cells(r - 3, 1).Select 'temp
Cells(r - 3, 1).Insert
ws.HPageBreaks.Add Before:=Cells(r - 3, 1)
r = r + 29
'Cells(r, 1).Select 'temporary
Loop

'Does cell contain "Type"?
If InStr(1, (Cells(r, 1).Value), "Type") > 0 Then
Cells(r, 1).Replace "  :", ": ", LookAt:=xlPart
ws.HPageBreaks.Add Before:=Cells(r, 1)
Cells(r - 3, _
    1).Range("a1:a3").EntireRow.Delete
r = r + 29
GoTo LineCTMmult

End If
'if empty
GoTo pgset

  
'CTM single const style
'Insert page breaks
LineCTMsing:
r = 33
'Cells(r, 1).Select 'temporary
ws.PageSetup.PrintTitleRows = "$1:$5"
Do
ws.HPageBreaks.Add _
    Before:=Cells(r, 1).Range("A2")
r = r + 28
Loop While Not IsEmpty(Cells(r, 1).Range("A2")) = True



pgset:
'Autofit rows and columns
LR = ws.Range("A" & Rows.Count).End(xlUp).Row

'Range("A" & LR).Activate
Range("A1:M" & LR).Rows.AutoFit
    Range("A1:M" & LR).Columns.AutoFit
    Range("A1:M" & LR).Rows.AutoFit

'construction task matrix
'page and print setup
With ws.PageSetup
    .LeftMargin = _
        Application.InchesToPoints(0.5)
    .RightMargin = _
        Application.InchesToPoints(0.5)
    .TopMargin = _
        Application.InchesToPoints(0.5)
    '.BottomMargin = Application.InchesToPoints(0.125)
    '.PrintGridlines = True
    .CenterHorizontally = True
    '.Orientation = xlLandscape
    '.PaperSize = xlPaperLetter
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = False
    .PrintArea = "A1:M" & LR
End With
Range("A1").Select
    'const task matrix
End Sub



'Jason R. Stillwell
'Little Dixie Community Action Agency
'209 N. 4th St.
'Hugo, OK 74743