Sub InitialData()
    Sheets("Sheet1").Select
    Range("B27").Select
    ActiveCell.FormulaR1C1 = "len("""")"
    Range("B35").Select
    ActiveCell.FormulaR1C1 = "code(""t"")"
    Range("B36").Select
    Sheets("Sheet2").Select
    Range("K22").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K23").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K24").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K25").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K26").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K27").Select
    ActiveCell.FormulaR1C1 = "zip001"
    Range("K28").Select
    ActiveCell.FormulaR1C1 = "zip002"
    Range("K29").Select
    ActiveCell.FormulaR1C1 = "zip003"
    Range("K30").Select
    ActiveCell.FormulaR1C1 = "zip004"
    Range("K31").Select
    ActiveCell.FormulaR1C1 = "zip005"
    Range("K32").Select
    ActiveCell.FormulaR1C1 = "zip006"
    Range("K33").Select
    ActiveCell.FormulaR1C1 = "zip007"
    Range("K34").Select
    ActiveCell.FormulaR1C1 = "zip008"
    Range("K35").Select
    ActiveCell.FormulaR1C1 = "zip009"
    Range("K36").Select
    ActiveCell.FormulaR1C1 = "zip010"
    Range("K37").Select
    ActiveCell.FormulaR1C1 = "zip010"
    Range("K38").Select
    ActiveCell.FormulaR1C1 = "zip011"
    Range("K39").Select
    ActiveCell.FormulaR1C1 = "zip012"
    Range("K40").Select
    ActiveCell.FormulaR1C1 = "zip013"
    Range("K41").Select
    ActiveCell.FormulaR1C1 = "zip014"
    Range("K42").Select
    ActiveCell.FormulaR1C1 = "zip015"
    Range("K43").Select
    ActiveCell.FormulaR1C1 = "zip016"
    Range("K44").Select
    ActiveCell.FormulaR1C1 = "zip017"
    Range("K45").Select
    ActiveCell.FormulaR1C1 = "zip018"
    Range("L22").Select
    ActiveCell.FormulaR1C1 = "aceO1"
    Range("L23").Select
    ActiveCell.FormulaR1C1 = "aceO2"
    Range("L24").Select
    ActiveCell.FormulaR1C1 = "aceO3"
    Range("L25").Select
    ActiveCell.FormulaR1C1 = "aceO4"
    Range("L26").Select
    ActiveCell.FormulaR1C1 = "aceO5"
    Range("L27").Select
    ActiveCell.FormulaR1C1 = "aceO6"
    Range("L28").Select
    ActiveCell.FormulaR1C1 = "rar_ace"
    Range("L29").Select
    ActiveCell.FormulaR1C1 = "aceO8"
    Range("L30").Select
    ActiveCell.FormulaR1C1 = "aceO9"
    Range("L31").Select
    ActiveCell.FormulaR1C1 = "aceO10"
    Range("L32").Select
    ActiveCell.FormulaR1C1 = "aceO11"
    Range("L33").Select
    ActiveCell.FormulaR1C1 = "aceO12"
    Range("L34").Select
    ActiveCell.FormulaR1C1 = "aceO13"
    Range("L35").Select
    ActiveCell.FormulaR1C1 = "aceO14"
    Range("L36").Select
    ActiveCell.FormulaR1C1 = "rar_ace"
    Range("L37").Select
    ActiveCell.FormulaR1C1 = "aceO16"
    Range("L38").Select
    ActiveCell.FormulaR1C1 = "aceO17"
    Range("L39").Select
    ActiveCell.FormulaR1C1 = "aceO18"
    Range("L40").Select
    ActiveCell.FormulaR1C1 = "aceO19"
    Range("L41").Select
    ActiveCell.FormulaR1C1 = "aceO20"
    Range("L42").Select
    ActiveCell.FormulaR1C1 = "aceO21"
    Range("L43").Select
    ActiveCell.FormulaR1C1 = "aceO22"
    Range("L44").Select
    ActiveCell.FormulaR1C1 = "aceO23"
    Range("L45").Select
    ActiveCell.FormulaR1C1 = "aceO24"
    Range("L46").Select
    Sheets("Sheet3").Select
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "my"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "77s"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "my"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "77s"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "ttt"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "my"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "77s"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "ttt"
    Range("N3").Select
    ActiveCell.FormulaR1C1 = "my"
    Range("N4").Select
    ActiveCell.FormulaR1C1 = "77s"
    Range("N5").Select
    ActiveCell.FormulaR1C1 = "ttt"
    Range("N13").Select
    ActiveCell.FormulaR1C1 = "my"
    Range("N14").Select
    ActiveCell.FormulaR1C1 = "77s"
    Range("N15").Select
    ActiveCell.FormulaR1C1 = "ttt"
End Sub


Sub GroupData()
With Worksheets("Sheet2")
    Dim EndRow As Long
    Dim CompanyEndRow As Long
    Dim r As Range
    Dim FindCell As Range
    Dim CompanyCount As Integer
    
    .Activate
    EndRow = IIf(.Range("K22").End(xlDown).Row = 1048576, 22, .Range("K22").End(xlDown).Row)
    CompanyEndRow = IIf(Worksheets("Sheet3").Range("C3").End(xlDown).Row = 1048576, 3, Worksheets("Sheet3").Range("F3").End(xlDown).Row)
    Worksheets("Sheet3").Range("C3:" & "D" & CompanyEndRow).ClearContents
    Worksheets("Sheet3").Range("F3:" & "H" & (3 + 9 * 3 - 1)).ClearContents
    Worksheets("Sheet3").Range("J3:" & "L" & (3 + 9 * 3 - 1)).ClearContents
    Worksheets("Sheet3").Range("J3:" & "L" & (3 + 9 * 3 - 1)).ClearContents
    Worksheets("Sheet3").[O3:O5].ClearContents
    Worksheets("Sheet3").[O13:O15].ClearContents
    .Range("K22:K" & EndRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Sheet3").Range("C3"), Unique:=True
    With Worksheets("Sheet3")
        If .Range("C3").End(xlDown).Row = 1048576 Then
            CompanyEndRow = 3
        Else
            .Range("C3:C" & .Range("C3").End(xlDown).Row).RemoveDuplicates Columns:=1, Header:=xlNo
            CompanyEndRow = IIf(.Range("C3").End(xlDown).Row = 1048576, 3, .Range("C3").End(xlDown).Row)
        End If
    End With
    For Each r In .Range("K22:K" & EndRow)
        If r.Offset(0, 1).Value <> "rar_ace" Then
            Set FindCell = Worksheets("Sheet3").Range("C3:C" & CompanyEndRow).Find(What:=r.Value, After:=Worksheets("Sheet3").Range("C3"), LookIn:=xlFormulas, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, MatchByte:=False, SearchFormat:=False)
            If Not FindCell Is Nothing Then
                    FindCell.Offset(0, 1).Value = IIf(FindCell.Offset(0, 1).Value = "", r.Offset(0, 1).Value, FindCell.Offset(0, 1).Value & "," & r.Offset(0, 1).Value)
            End If
        End If
    Next r
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    With Worksheets("Sheet3")
        For Each r In .Range("C3:C" & CompanyEndRow)
            CompanyCount = CompanyCount + 1
            If CompanyCount <= 9 Then
                .Range("F" & (3 + (CompanyCount - 1) * 3)).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("F" & (3 + (CompanyCount - 1) * 3) + 1).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("F" & (3 + (CompanyCount - 1) * 3) + 2).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("G" & (3 + (CompanyCount - 1) * 3)).Value = "A"
                .Range("G" & (3 + (CompanyCount - 1) * 3) + 1).Value = .Range("D" & (3 + CompanyCount - 1)).Value
                .Range("G" & (3 + (CompanyCount - 1) * 3) + 2).Value = "B"
                .Range("H" & (3 + (CompanyCount - 1) * 3)).Value = "AA"
                .Range("H" & (3 + (CompanyCount - 1) * 3) + 1).Value = "BB"
                .Range("H" & (3 + (CompanyCount - 1) * 3) + 2).Value = "CC"
            Else
                .Range("J" & (3 + (CompanyCount - 9 - 1) * 3)).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("J" & (3 + (CompanyCount - 9 - 1) * 3) + 1).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("J" & (3 + (CompanyCount - 9 - 1) * 3) + 2).Value = .Range("C" & (3 + CompanyCount - 1)).Value
                .Range("K" & (3 + (CompanyCount - 9 - 1) * 3)).Value = "A"
                .Range("K" & (3 + (CompanyCount - 9 - 1) * 3) + 1).Value = .Range("D" & (3 + CompanyCount - 1)).Value
                .Range("K" & (3 + (CompanyCount - 9 - 1) * 3) + 2).Value = "B"
                .Range("L" & (3 + (CompanyCount - 9 - 1) * 3)).Value = "AA"
                .Range("L" & (3 + (CompanyCount - 9 - 1) * 3) + 1).Value = "BB"
                .Range("L" & (3 + (CompanyCount - 9 - 1) * 3) + 2).Value = "CC"
            End If
        Next r
        CompanyEndRow = IIf(.Range("F3").End(xlDown).Row = 1048576, 3, .Range("F3").End(xlDown).Row)
        For Each r In .Range("F3:F" & CompanyEndRow)
            .[O3].Value = IIf(.[O3].Value = "", r.Value, .[O3].Value & "|" & r.Value)
            .[O4].Value = IIf(.[O4].Value = "", r.Offset(0, 1).Value, .[O4].Value & "|" & r.Offset(0, 1).Value)
            .[O5].Value = IIf(.[O5].Value = "", r.Offset(0, 2).Value, .[O5].Value & "|" & r.Offset(0, 2).Value)
        Next r
        CompanyEndRow = IIf(.Range("J3").End(xlDown).Row = 1048576, 3, .Range("J3").End(xlDown).Row)
        For Each r In .Range("J3:J" & CompanyEndRow)
            .[O13].Value = IIf(.[O13].Value = "", r.Value, .[O13].Value & "|" & r.Value)
            .[O14].Value = IIf(.[O14].Value = "", r.Offset(0, 1).Value, .[O14].Value & "|" & r.Offset(0, 1).Value)
            .[O15].Value = IIf(.[O15].Value = "", r.Offset(0, 2).Value, .[O15].Value & "|" & r.Offset(0, 2).Value)
        Next r
        .Activate
    End With
    With Worksheets("Sheet1")
        .[C3].Formula = "=" & .[B27].Value & ""
        .[C7].Formula = "=" & .[B35].Value & ""
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End With
End Sub