Sub Create_Master_file()
Dim FirstRow As Long
' Check to see if data in cell A1 and if not, insert row
If Range("A1") <> "" Then
Rows(1).Insert
Else
' Find first row with data in column A
FirstRow = Range("A1").End(xlDown).Row
' Delete rows if FirstRow greater than 2
If FirstRow > 2 Then
Rows("2:" & FirstRow - 1).Delete
End If
End If
Dim LastRow As Long
Dim LastCol As Long
Dim iRow As Long
Dim ws As Worksheet
Set ws = ActiveSheet
With ws
LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column ' needs to be a 2 due to headers start on row 2
.Columns(LastCol + 1).EntireColumn.Insert
With .Cells(2, LastCol + 1)
.Value = "xxx"
.Interior.Color = 255
.Font.Color = vbWhite
End With
.Columns(LastCol + 2).EntireColumn.Insert
With .Cells(2, LastCol + 2)
.Value = "xxx"
.Interior.Color = 255
.Font.Color = vbWhite
End With
.Columns(LastCol + 3).EntireColumn.Insert
With .Cells(2, LastCol + 3)
.Value = "xxx"
.Interior.Color = 255
.Font.Color = vbWhite
End With
.Columns(LastCol + 4).EntireColumn.Insert
With .Cells(2, LastCol + 4)
.Value = "xxx"
.Interior.Color = 255
.Font.Color = vbWhite
End With
.Columns(LastCol + 5).EntireColumn.Insert
With .Cells(2, LastCol + 5)
.Value = "xxx"
.Interior.Color = RGB(226, 239, 218)
.Font.Color = vbBlack
End With
.Columns(LastCol + 6).EntireColumn.Insert
With .Cells(2, LastCol + 6)
.Value = "xxx"
.Interior.Color = RGB(226, 239, 218)
.Font.Color = vbBlack
End With
.Columns(LastCol + 7).EntireColumn.Insert
With .Cells(2, LastCol + 7)
.Value = "xxx"
.Interior.Color = RGB(226, 239, 218)
.Font.Color = vbBlack
End With
.Columns(LastCol + 8).EntireColumn.Insert
With .Cells(2, LastCol + 8)
.Value = "xxx"
.Interior.Color = RGB(226, 239, 218)
.Font.Color = vbBlack
End With
Cells.Select
With Selection.Font
.Name = "Calibri"
.Size = 9
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection
.BorderAround xlContinuous, xlThin, 0
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
End With
Dim sh As Worksheet, LstRw As Long, LstCol As Long, jRng As Range, x, xRng As Range
Set sh = ActiveSheet
With sh
LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row
LstCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
Set jRng = .Range(.Cells(3, LstCol - 1), .Cells(LstRw, LstCol - 1))
For x = LstCol - 4 To LstCol - 3
Set xRng = .Range(.Cells(3, x), .Cells(LstRw, x))
.Cells(1, x) = "=SUMPRODUCT(" & xRng.Address & "," & jRng.Address & ")"
Next x
.Cells(1, LstCol - 1) = "=sum(" & jRng.Address & ")"
.Cells(1, LstCol) = "=sum(" & jRng.Offset(, 1).Address & ")"
End With
End With
End Sub