title: Cells Format and subtotals with VBA
body: <p>I have created a VBA macro to give the format to  Sheet in excel and create some subtotals. </p>
  
  <p>It works, but has a lot of room for improvement. </p>
  
  <p>Right now it takes very long. </p>
  
  <p>I know that using Matrix the processing time could be reduced to milliseconds.</p>
  
  <pre><code>Sub justsubttotals()
  Sheets("Produktionsplan").Select
  'Delete previous format
  Range("A4:I1000").Select
  With Selection.Interior
      .Pattern = xlNone
      .TintAndShade = 0
      .PatternTintAndShade = 0
  End With
  Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  With Selection.Borders(xlEdgeLeft)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .TintAndShade = 0
      .Weight = xlMedium
  End With
  With Selection.Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .TintAndShade = 0
      .Weight = xlMedium
  End With
  With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlHairline
  End With
  With Selection.Borders(xlEdgeRight)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .TintAndShade = 0
      .Weight = xlMedium
  End With
  With Selection.Borders(xlInsideVertical)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .TintAndShade = 0
      .Weight = xlHairline
  End With
  With Selection.Borders(xlInsideHorizontal)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .TintAndShade = 0
      .Weight = xlHairline
  End With
  'I define 3 start variables with the first row of the matrix (per default it  always starts in row 4).
   primero = 4
   fin = 4
   contar = 4
     'Identify how many rows are in the file
      Finalrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
      For j = 4 To Finalrow
  If Cells(j, 1) = 0 And contar &lt;= Finalrow Then
  Cells(j, 1).Select
  Selection.EntireRow.Select
  Selection.Delete Shift:=xlUp
  j = j - 1
  contar = contar + 1
  Else
  contar = contar + 1
  End If
  Next
  
  inicio = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
  'Este inicio lo guardo para la parte de los subtotales
  inicio2 = inicio
   'Este inicio si es para los formatos
   inicio = inicio + 1
  
  
  
  
   For i = 4 To inicio
  
  For j = primero To inicio
      If Cells(primero, 4) = Cells(fin + 1, 4) Then
          fin = fin + 1
      Else
          j = inicio
      End If
  Next
  
  
  'Based on the description of column 2, I know which colour to assign
  
   If Cells(primero, 2) = "B. Rück RH" Or Cells(primero, 2) = "B. 7 OB RH" Then
      Range("A" &amp; primero &amp; ":I" &amp; fin).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent6
          .TintAndShade = 0.699981688894314
          .PatternTintAndShade = 0
      End With
  
   ElseIf Cells(primero, 2) = "B. Rück LH" Or Cells(primero, 2) = "B. 7 OB LH" Then
      Range("A" &amp; primero &amp; ":I" &amp; fin).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent6
          .TintAndShade = 0.499981688894314
          .PatternTintAndShade = 0
      End With
  
   ElseIf Cells(primero, 2) = "B. 7 SAMS Center  " Then
      Range("A" &amp; primero &amp; ":I" &amp; fin).Select
  With Selection.Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 8771461
      .TintAndShade = 0
      .PatternTintAndShade = 0
  End With
  
   ElseIf Cells(primero, 2) = "B. 7 SAMS LH  " Then
      Range("A" &amp; primero &amp; ":I" &amp; fin).Select
  With Selection.Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 8771461
      .TintAndShade = 0
      .PatternTintAndShade = 0
  End With
  
   ElseIf Cells(primero, 2) = "B. 7 SAMS RH  " Then
      Range("A" &amp; primero &amp; ":I" &amp; fin).Select
  With Selection.Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 8771461
      .TintAndShade = 0
      .PatternTintAndShade = 0
  End With
  
   ElseIf Cells(primero, 2) = "B. 634 RH/LH  " Then
      Range("A" &amp; primero &amp; ":I" &amp; fin).Select
  With Selection.Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 6723891
      .TintAndShade = 0
      .PatternTintAndShade = 0
  End With
  
   ElseIf Cells(primero, 2) = "B. Vor RH" Then
      Range("A" &amp; primero &amp; ":I" &amp; fin).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent5
          .TintAndShade = 0.699981688894314
          .PatternTintAndShade = 0
      End With
  
  ElseIf Cells(primero, 2) = "B. Vor LH" Then
       Range("A" &amp; primero &amp; ":I" &amp; fin).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent2
          .TintAndShade = 0.699981688894314
          .PatternTintAndShade = 0
      End With
  
  ElseIf Cells(primero, 2) = "Porsche RH" Then
      Range("A" &amp; primero &amp; ":I" &amp; fin).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent5
          .TintAndShade = 0.399975585192419
          .PatternTintAndShade = 0
      End With
  
  ElseIf Cells(primero, 2) = "Porsche LH" Then
       Range("A" &amp; primero &amp; ":I" &amp; fin).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent2
          .TintAndShade = 0.399993896298105
          .PatternTintAndShade = 0
      End With
  
  ElseIf Cells(primero, 2) = "Audi RH" Then
       Range("A" &amp; primero &amp; ":I" &amp; fin).Select
      With Selection.Interior
          .Pattern = xlSolid
      .ThemeColor = xlThemeColorDark2
      .TintAndShade = -9.99786370433668E-02
          .TintAndShade = 0.699981688894314
          .PatternTintAndShade = 0
      End With
  
  ElseIf Cells(primero, 2) = "Audi LH" Then
       Range("A" &amp; primero &amp; ":I" &amp; fin).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
      .ThemeColor = xlThemeColorAccent3
      .TintAndShade = 0.599993896298105
          .PatternTintAndShade = 0
      End With
  
  
      Else
      Range("A" &amp; primero &amp; ":I" &amp; fin).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorDark1
          .TintAndShade = 0
          .PatternTintAndShade = 0
      End With
  
  End If
  
  
  
      Range("A" &amp; primero &amp; ":I" &amp; fin).Select
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlEdgeTop)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlEdgeBottom)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlEdgeRight)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlInsideVertical)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlHairline
      End With
  
  primero = fin + 1
  Next
  
  
  
   '************************************************
     'I create the subtotals
   '************************************************
    primero = 4
    fin = 4
    inicio = inicio2
  
  For i = 4 To inicio
  
  For j = primero To inicio
      If Cells(primero, 4) = Cells(fin + 1, 4) Then
          fin = fin + 1
      Else
          j = inicio
      End If
  Next
  If fin &gt; primero Then
      Rows(fin + 1 &amp; ":" &amp; fin + 1).Select
      Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      inicio = inicio + 1
      Range("H" &amp; fin + 1).Select
      Cells(fin + 1, 8).Value = "=Sum(H" &amp; primero &amp; ":H" &amp; fin &amp; ")"
      Range("H" &amp; fin + 1).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .Color = 65535
          .TintAndShade = 0
          .PatternTintAndShade = 0
      End With
      Selection.Font.Bold = True
  Else
          Range("H" &amp; fin).Select
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .Color = 65535
          .TintAndShade = 0
          .PatternTintAndShade = 0
      End With
      Selection.Font.Bold = True
  
  End If
  
    primero = fin + 1
    Next
  
    '************************************************
    'I use the formula of another sheet
    '************************************************
  
  Sheets("RuestenMatrix").Select
  Range("J1").Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("Produktionsplan").Select
  Range("J4:J810").Select
  ActiveSheet.Paste
  
     '************************************************
     'Once again I use the formula of another sheet
     '************************************************
  Sheets("Pause Zeit").Select
  Range("K4:K5").Select
  Selection.Copy
  Sheets("Produktionsplan").Select
  Range("K4").Select
  ActiveSheet.Paste
  Range("K5").Select
  Application.CutCopyMode = False
  Selection.AutoFill Destination:=Range("K5:K810")
  Range("K5:K810").Select
  
     '************************************************
      'One more time I use the formula of another sheet
     '************************************************
   Cells(4, 13).Select
  Sheets("Pause Zeit").Select
  Range("M4:P5").Select
  Selection.Copy
  Sheets("Produktionsplan").Select
  ActiveSheet.Paste
  Range("M5:P5").Select
  Application.CutCopyMode = False
  Selection.AutoFill Destination:=Range("M5:P872")
  Range("M5:P872").Select
  Range("M4").Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
  Application.CutCopyMode = False
  Selection.Font.Bold = True
  
  
  End Sub
  </code></pre>