Sub CollectData()
Application.ScreenUpdating = False
Sheets("Report").Select
Range(Range("Start").Offset(1, 0), _
Range("Start").Offset(1, 0).End(xlDown).End(xlDown).Offset(0, 6)).Select
Selection.ClearContents
With Selection.Borders(xlEdgeTop)
.LineStyle = xlNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Sheets("Data").Select
Range("DateBegin").Activate
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset.End(xlDown).Offset(0, 3)).Select
Selection.Copy
Sheets("Report").Select
Range("Start").Offset(1, 0).Select
'ActiveSheet.Paste
'Application.CutCopyMode = False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Do Until ActiveCell.Offset(-1, 0).Value = Range("DateFuture").Value
'Do Until ActiveCell.Value = 0
' ActiveCell.Offset(1, 0).Activate
'If ActiveCell.Offset(0, 1).Value <> 0 Then
' ActiveWorkbook.Names.Add Name:="DateData", RefersToR1C1:=Selection
' Insert
' Sheets("Data").Select
' Range("DateData").Activate
' ActiveWorkbook.Names("DateData").Delete
'End If
'Loop
CopyFormulas
Range(Range("Start"), Range("Start").Offset(0, 5)).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("F19").Select
Range(Range("Start"), Range("Start").Offset(0, 5)).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range(Range("Start").Offset(1, 0), _
Range("Start").Offset(1, 0).End(xlDown).End(xlDown).Offset(0, 5)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Range(Range("Start").Offset(1, 3), _
Range("Start").Offset(1, 0).End(xlDown).End(xlDown).Offset(0, 3)).Select
Selection.NumberFormat = "$#,##0.00_);($#,##0.00)"
Range(Range("Start").Offset(1, 5), _
Range("Start").Offset(1, 0).End(xlDown).End(xlDown).Offset(0, 5)).Select
Selection.NumberFormat = "$#,##0.00_);($#,##0.00)"
Range(Range("Start").Offset(1, 0), Range("Start").Offset(1, 0).End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.NumberFormat = "m/d/yyyy"
.HorizontalAlignment = xlRight
End With
Range(Range("Start").Offset(1, 2), _
Range("Start").Offset(1, 0).End(xlDown).End(xlDown).Offset(0, 2)).Select
With Selection
.HorizontalAlignment = xlLeft
End With
Range(Range("Start").Offset(1, 1), _
Range("Start").Offset(1, 0).End(xlDown).End(xlDown).Offset(0, 1)).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Range(Range("Start").Offset(1, 3), _
Range("Start").Offset(1, 0).End(xlDown).End(xlDown).Offset(0, 3)).Select
With Selection
.HorizontalAlignment = xlRight
End With
Range(Range("Start").Offset(1, 4), _
Range("Start").Offset(1, 0).End(xlDown).End(xlDown).Offset(0, 4)).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Range(Range("Start").Offset(1, 5), _
Range("Start").Offset(1, 0).End(xlDown).End(xlDown).Offset(0, 5)).Select
With Selection
.HorizontalAlignment = xlRight
End With
Range(Range("Start").Offset(1, 0), _
Range("Start").Offset(1, 0).End(xlDown).End(xlDown).Offset(0, 6)).Select
With Selection.Font
.Name = "Arial Nova Cond"
.Size = 10
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
'.TintAndShade = 0
.Weight = xlThin
End With
Range("Start").Offset(1, 0).Activate
Do Until ActiveCell.Value = 0
ActiveCell.Offset(1, 0).Activate
If Abs(ActiveCell.Offset(-1, 3).Value) < 0.005 Then
ActiveCell.Offset(-1, 0).Select
Selection.EntireRow.Delete
'ActiveCell.Offset(1, 0).Activate
End If
Loop
Range("Start").Activate
End Sub
Sub Insert()
Sheets("Report").Select
Range("Start").Activate
Do Until ActiveCell.Value = 0
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Value = Range("DateData").Value
ActiveCell.Offset(0, 1).Value = Range("DateData").Offset(0, 1).Value
End Sub
Sub CopyFormulas()
Sheets("Report").Select
Dim FVTotalRange As Range
Dim RDTotalRange As Range
'If Name.exists("FVTotalRange") Then ActiveWorkbook.Names("FVTotalRange").Delete
'Copy formulas from Row 1 and paste into data table
Range("Formulas").Select
Selection.Copy
Range(Range("Start").Offset(1, 4), Range("Start").Offset(1, 0).End(xlDown).Offset(0, 6)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("Start").End(xlDown).Offset(2, 0).Activate
ActiveCell.Value = "TOTAL"
ActiveCell.Offset(0, 5).Activate
Set FVTotalRange = Range(ActiveCell.Offset.End(xlUp).End(xlUp).Offset(1, 0), ActiveCell.Offset(-2, 0))
FVTotalRange.Select
ActiveWorkbook.Names.Add Name:="FVTotalRange", RefersToR1C1:=Selection
Range("Start").Offset.End(xlDown).End(xlDown).Offset(0, 5).Activate
ActiveCell.FormulaR1C1 = "=SUM(fvtotalrange)"
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("FVTotalReport").Value = ActiveCell.Value
Set RDTotalRange = Range(Range("Start").Offset(1, 3), Range("Start").Offset(1, 3).End(xlDown))
RDTotalRange.Select
ActiveWorkbook.Names.Add Name:="RDTotalRange", RefersToR1C1:=Selection
Range("Start").Offset.End(xlDown).End(xlDown).Offset(0, 3).Activate
ActiveCell.FormulaR1C1 = "=SUM(rdtotalrange)"
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub