Hi all ,

I 've a following macro which i got with big help from lot of frnds from excel forum. This runs just perfect . Now i need to make addtion to this macro.

Currently this macro works if rows in my data sheet remain same . To make it easy to understand have a look in attached excel sheet . If i have those highlightes columns , macros does not work , if i remove them it works. can some kindly update this macro to include thos highlighted columns.

Also please inform which part/parts of macro has been update as it will increase my knowledge.

Here is the code & attached file.

Test File

Sub main()
  Dim nodupes As New Collection
  
  Sheets("Sites Data").Activate
  ActiveSheet.Names.Add Name:="DataRng", RefersTo:="=A1:BD" & Cells(Rows.Count, 1).End(xlUp).Row
  For Each ce In Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    If ce = "CSS" Then
      On Error Resume Next
      nodupes.Add Item:=ce.Offset(0, 20).Value, Key:=ce.Offset(0, 20).Value
      On Error GoTo 0
    End If
  Next ce
  
  Call aaa(nodupes)
  Sheets("Sites Data").Activate
  For i = 1 To nodupes.Count
    Application.StatusBar = nodupes(i)
    Call bbb("CSS", nodupes(i))
  Next i
  Application.StatusBar = False
End Sub
Sub aaa(nodupes)
  'this program determines the distinct group by items for BU CSS
  'and creates output sheets if they don't exist.
  Dim ChkSH As Worksheet
  For i = 1 To nodupes.Count
    On Error Resume Next
    Set ChkSH = Nothing
    Set ChkSH = Sheets(nodupes(i))
    On Error GoTo 0
    If ChkSH Is Nothing Then
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Name = nodupes(i)
    End If
  Next i
  
  
End Sub
Sub bbb(prod, grpby)
  Dim OuTSH As Worksheet
  'prod = "CSS"
  Set OuTSH = Sheets(grpby)
  OuTSH.Range("A1:A" & OuTSH.Cells(Rows.Count, 1).End(xlUp).Row).EntireRow.RowHeight = ActiveSheet.StandardHeight
  OuTSH.Cells.Clear
  
  'Sheets("Sites Data").Activate
  Range("A1").Select
  
  OuTSH.Range("A1:D1").Value = Array("BU", "RG9", "Ext / Int", "Group By")
  OuTSH.Range("A2:D2").Value = Array(prod, ">0", "INT", grpby)
  
  OuTSH.Range("A4:E4").Value = Array("Prefered Name", "RG9 Apps Shakeout - Verify App Deployment is complete", "RG9 Apps Shakeout - Verify users can login successfully", "RG9 Apps Shakeout - Verify users have correct roles", "Ext / Int")
  Sheets(1).Range("DataRng").AdvancedFilter Action:=xlFilterCopy, criteriarange:=OuTSH.Range("A1:D2"), copytorange:=OuTSH.Range("A4:E4")
    
  If OuTSH.Cells(Rows.Count, 1).End(xlUp).Row > 4 Then Call formatINT(OuTSH)
  
  With OuTSH.Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
    .Value = "EXTERNAL"
    .Font.Bold = True
  End With
  
  outrow = OuTSH.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  OuTSH.Range("A" & outrow & ":D" & outrow).Value = Array("BU", "RG9", "Ext / Int", "Group By")
  OuTSH.Range("A" & outrow + 1 & ":D" & outrow + 1).Value = Array(prod, ">0", "EXT", grpby)
  OuTSH.Range("A" & outrow + 2 & ":E" & outrow + 2).Value = Array("Prefered Name", "RG9 Apps Shakeout - Verify App Deployment is complete", "RG9 Apps Shakeout - Verify users can login successfully", "RG9 Apps Shakeout - Verify users have correct roles", "Ext / Int")
  OuTSH.Range("A" & outrow + 2).EntireRow.RowHeight = 46
  OuTSH.Range("B" & outrow + 2 & ":E" & outrow + 2).WrapText = True
  
  Sheets(1).Range("DataRng").AdvancedFilter Action:=xlFilterCopy, criteriarange:=OuTSH.Range("A" & outrow & ":D" & outrow + 1), copytorange:=OuTSH.Range("A" & outrow + 2 & ":E" & outrow + 2)
  Call formatEXT(OuTSH, outrow + 3)
  
  Call formatGT(OuTSH, prod, grpby)
  
  Sheets(grpby).Activate
  Range("A2").Value = "INTERNAL"
  Range("A2").Font.Bold = True
  Range("A2:E4").Interior.ColorIndex = 15
  Range("A1").Select
  
End Sub
Sub formatINT(OuTSH)
  formrow = OuTSH.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  
  With OuTSH
    .Cells(formrow, "A").Value = "INT Total"
    .Cells(formrow, "A").Font.Bold = True
    .Cells(formrow, "B").Formula = "=SUM(B5:B" & formrow - 1 & ")/COUNTA($A5:$A" & formrow - 1 & ")"
    .Cells(formrow, "B").NumberFormat = "0%"
    .Cells(formrow, "B").AutoFill Destination:=.Range(.Cells(formrow, "B"), .Cells(formrow, "E"))
    .Cells(formrow, "A").Resize(7, 5).Interior.ColorIndex = 15
    .Range("E4").Value = "Overall"
    .Range("E5").Formula = "=SUM(B5:D5)/3"
    .Range("E5").NumberFormat = "0%"
    '.Range("D5").Copy
    '.Range("E5").PasteSpecial (xlPasteFormats)
    If formrow - 1 > 5 Then
      .Range("E5").AutoFill Destination:=.Range("E5:E" & formrow - 1)
      .Range("B5:D" & formrow - 1).NumberFormat = "0%"
    End If
  End With
End Sub
Sub formatEXT(OuTSH, startrow)
  formrow = OuTSH.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  If formrow > startrow Then
    With OuTSH
      .Cells(formrow, "A").Value = "EXT Total"
      .Cells(formrow, "A").Font.Bold = True
      .Cells(formrow, "B").Formula = "=SUM(B" & startrow & ":B" & formrow - 1 & ")/COUNTA($A" & startrow & ":$A" & formrow - 1 & ")"
      .Cells(formrow, "B").NumberFormat = "0%"
      .Cells(formrow, "B").AutoFill Destination:=.Range(.Cells(formrow, "B"), .Cells(formrow, "E"))
      .Cells(formrow, "A").Resize(1, 5).Interior.ColorIndex = 15
      .Range("E" & startrow - 1).Value = "Overall"
      .Range("E" & startrow).Formula = "=SUM(B" & startrow & ":D" & startrow & ")/3"
      .Range("E" & startrow).NumberFormat = "0%"
      '.Range("D" & startrow).Copy
      '.Range("E" & startrow).PasteSpecial (xlPasteFormats)
      If formrow - 2 > startrow - 1 Then
        .Range("E" & startrow).AutoFill Destination:=.Range("E" & startrow & ":E" & formrow - 1)
        .Range("B" & startrow & ":D" & formrow - 1).NumberFormat = "0%"
      End If
    
    End With
  End If
End Sub
Sub formatGT(OuTSH, prod, grpby)
  With OuTSH
    arr = Array("BU", "RG9 Apps Shakeout - ", "Ext / Int", "Prefered Name", "RG9", ">0", "Group By", grpby, prod)
    For i = LBound(arr) To UBound(arr)
      .Cells.Replace what:=arr(i), replacement:=""
    Next i
    .Range("C:C").Replace what:="INT", replacement:=""
    .Range("C:C").Replace what:="EXT", replacement:=""
    .Range("B:E").HorizontalAlignment = xlCenter
    .Rows("4:4").RowHeight = 46
    .Range("B4:E4").WrapText = True
    
    formrow = .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
    .Range("A" & formrow).Value = "Grand Total"
    .Range("A" & formrow).Font.Underline = xlUnderlineStyleDouble
    
    inTStartrow = 5
    If WorksheetFunction.CountIf(.Range("A:A"), "INT Total") = 0 Then
      intendrow = 5
    Else
      intendrow = WorksheetFunction.Match("INT Total", .Range("A:A"), 0) - 1
    End If
    If WorksheetFunction.CountIf(.Range("A:A"), "EXT Total") > 0 Then
      Set findit = .Range("A:A").Find(what:="EXTERNAL")
      exTStartrow = findit.Row + 4 'findit.End(xlDown).Row
      extendrow = WorksheetFunction.Match("EXT Total", .Range("A:A"), 0) - 1
      Set extrng = .Range("A" & exTStartrow & ":A" & extendrow)
    End If
    Set intrng = .Range("A" & inTStartrow & ":A" & intendrow)
    If Not IsEmpty(extrng) Then
      Set rng = Union(intrng, extrng)
    Else
      Set rng = intrng
    End If
    .Range("B" & formrow).Formula = "=sum(" & rng.Offset(0, 1).Address & ")/counta(" & rng.Address & ")"
    .Range("B" & formrow).Replace what:="$B", replacement:="B"
    .Range("B" & formrow).NumberFormat = "0%"
    .Range("B" & formrow).AutoFill Destination:=.Range("B" & formrow & ":E" & formrow)
    .Range("A" & formrow).Resize(1, 5).Interior.ColorIndex = 44
    
    .Range("A:A").ColumnWidth = 35
    .Range("B:E").ColumnWidth = 14
  End With
End Sub
Please ask me if any questions abt my request.