Code:Sub addCols() Dim ws As Worksheet Dim j As Long Dim lr As Long Set ws = ActiveSheet lr = ws.Range("a4").End(xlDown).Row 'in your example, row 15 With ws .Range("b1").Copy .Range("g1").PasteSpecial .Range("g2:j2").PasteSpecial .Application.CutCopyMode = False .Range("g1").Select .Range("g1").Value = "Forecast" .Range("g1:j1").MergeCells = True .Range("g1:j1").HorizontalAlignment = xlCenterAcrossSelection .Range("g2").Value = "Best" .Range("h2").Value = "Likely" .Range("i2").Value = "Worst" .Range("j2").Value = "Spread" .Range("b5:b" & lr).Copy .Range("g5").PasteSpecial xlPasteFormats .Range("h5").PasteSpecial xlPasteFormats .Range("i5").PasteSpecial xlPasteFormats .Range("j5").PasteSpecial xlPasteFormats .Range("g2:g" & lr).Interior.Color = 12379352 .Range("h2:h" & lr).Interior.Color = 15986394 .Range("i2:i" & lr).Interior.Color = 14281213 .Range("j5").Formula = "=g5-i5" .Range("j5").Copy .Range("j6:j" & lr).PasteSpecial Application.CutCopyMode = False .Range("b" & lr + 2).FormulaR1C1 = "=SUM(R[" & 5 - (lr + 2) & "]C:R[-2]C)" .Range("b" & lr + 2).Copy .Range("c" & lr + 2 & ":e" & lr + 2).PasteSpecial .Range("g" & lr + 2 & ":j" & lr + 2).PasteSpecial Application.CutCopyMode = False .Range("a" & lr + 2).Value = "Total" 'changed this to "lr +2" .Range("k1").Value = "Comments" .Range("k1").Font.Bold = True .Range("k1").Font.Italic = True .Range("k1").ColumnWidth = 20 .Range("k1").HorizontalAlignment = xlCenter .Range("k1:k2").Merge .Range("g5").Select .Range("g1:j1").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic .Range("g2:i2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic .Range("j2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic .Range("k1:k2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic With .Range("g3:g" & lr).Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlColorIndexAutomatic End With With .Range("i3:i" & lr).Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlColorIndexAutomatic End With With .Range("j3:j" & lr).Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlColorIndexAutomatic End With With .Range("k3:k" & lr).Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlColorIndexAutomatic End With End With Set ws = Nothing End Sub




Reply With Quote
