Solved

VBA formatting from Array

Posted on 2013-10-28
8
319 Views
Last Modified: 2013-11-03
I would like to know the best way to have the attached report generate from an Array I have filled.  In the first table I put the array values in the fields they would fill.  The table headings would remain constant.  I am using the SSN as a unique ID to determine when a new table would start with Array(i).SupName.  Any help would be greatly appreciated.

MartinLiss, I am using the array format you taugh me for this.
Supervisor-Breakout.xlsx
0
Comment
Question by:Chris Pfeiffer
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 2
8 Comments
 
LVL 47

Expert Comment

by:Martin Liss
ID: 39605919
I'm sorry but I don't understand the question? What array are you referring to?
0
 
LVL 2

Author Comment

by:Chris Pfeiffer
ID: 39606300
Where you load everything into a public
Type. Like you told me I'm this question. http://mobile.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28171277.html
0
 
LVL 2

Author Comment

by:Chris Pfeiffer
ID: 39606308
I want to know how to get something like the attached spreadsheet to be displayed from an array of information. Long ago I would have used crystal reports but that's not an option ever in vba
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 47

Expert Comment

by:Martin Liss
ID: 39606387
Okay even though I helped you with that it's a lot to look through. Do you have a workbook that shows the data from which you want to generate the report? And what kind of "report" do you want? A printed worksheet or...?
0
 
LVL 2

Author Comment

by:Chris Pfeiffer
ID: 39606901
I have attached a new excel file.  I need a report to print on a worksheet like I have provided.  This will come when the module "SupRosterBreakout" is called.  I have included the 3 modules used to generate the informaion to fill the worksheet.  Let me know if this helps thanks.
Supervisor-Breakout.xlsm
0
 
LVL 2

Author Comment

by:Chris Pfeiffer
ID: 39607110
I got the report to print out the way I want I am just working on the formatting now.  See attached code.  There are comments on how the formatting is needed if you still would like to help on that portion.
Sub GenBreakoutRoster()
    Dim memberCount As Integer
    Dim SupName As String, SelectedSupName As String
    Dim SupNameLen As Integer, SelectedSupNameLen As Integer
    Dim xTroop As Integer   'increment the supervisor array
    xTroop = 0

    Dim SupIDKey As String  'This is the place holder for the SupID in the ArraySupRosterBreakout will be SSN
    Dim SupFullName As String    ' This will have the Sup Name and Rank for the heading

    LoadArray.LoadAlphaRosterArray
    Sheet4.Activate
    memberCount = Cells(Rows.count, "A").End(xlUp).Row
    ReDim ArraySupRosterBreakout(memberCount)

    For X = LBound(ArrayMemberData) To UBound(ArrayMemberData)
        SupIDKey = ArrayMemberData(X).SSAN
        SupFullName = ArrayMemberData(X).Grade & " " & ArrayMemberData(X).Full_Name
        SelectedSupName = ArrayMemberData(X).Full_Name
        SelectedSupName = UCase(Replace(SelectedSupName, " ", ""))
        SelectedSupName = Replace(SelectedSupName, ",", "")
        SelectedSupNameLen = Len(SelectedSupName)

        For i = LBound(ArrayMemberData) To UBound(ArrayMemberData)
            SupName = ArrayMemberData(i).Supv_Name
            SupName = UCase(Replace(SupName, " ", ""))
            SupName = Replace(SupName, ",", "")
            SupNameLen = Len(SupName)

            If SupNameLen <> 0 Then
                If Left(SupName, SupNameLen) = Left(SelectedSupName, SupNameLen) Then
                    ArraySupRosterBreakout(xTroop).SupID = SupIDKey
                    ArraySupRosterBreakout(xTroop).SupName = SupFullName
                    ArraySupRosterBreakout(xTroop).TroopRank = ArrayMemberData(i).Grade
                    ArraySupRosterBreakout(xTroop).TroopName = ArrayMemberData(i).Full_Name
                    ArraySupRosterBreakout(xTroop).SupStartDate = ArrayMemberData(i).Supv_Begin_Date
                    ArraySupRosterBreakout(xTroop).NoDaySup = CDate(Date) - CDate(ArrayMemberData(i).Supv_Begin_Date)    ' number of days under current supervision
                    ArraySupRosterBreakout(xTroop).NoDaySupDEROS = CDate(ArrayMemberData(X).DEROS) - CDate(ArrayMemberData(i).Supv_Begin_Date)  ' add the time between SupStartDate and DEROS of SUP
                    ArraySupRosterBreakout(xTroop).EPRCloseout = ArrayMemberData(i).Proj_Eval_Close_Date
                    ArraySupRosterBreakout(xTroop).DaysUntilCloseout = CDate(ArrayMemberData(i).Proj_Eval_Close_Date) - CDate(Date)    'days until closeout
                    ArraySupRosterBreakout(xTroop).DutyTitle = ArrayMemberData(i).Duty_Title
                    ArraySupRosterBreakout(xTroop).SupDEROS = ArrayMemberData(X).DEROS
                    xTroop = xTroop + 1
                End If
            End If
        Next i
    Next X

    'Temp solution for filling the roster to sendout
    Sheet18.Activate
    Dim trigger As Integer    ' tells when the supervisor changes and when to start a new table
    Dim t As Integer    ' ArraySupRosterBreakout indexer
    Dim txCountLocation As Integer
    Dim txCount As Integer    ' number of troops under each sup.
    'this is added to the t count to get the next sup as well.
    X = 1
    txCount = 0
    For t = LBound(ArraySupRosterBreakout) To UBound(ArraySupRosterBreakout)
        'all cells down to first x = x+1 should be Bold font
        Cells(X, 1).Value = ArraySupRosterBreakout(t).SupName    '<-- filled yellow background
        Cells(X, 2).Value = "Number of Troops:"
        txCountLocation = X    ' this will store the location the txCount value will go to add total troop count Cells(X, 3).Value = "XX"    ' ADD THE NUMBER OF TIMES THE TROOPS CYCLE RUNS.
        Cells(X, 5).Value = "DEROS"
        Cells(X, 6).Value = ArraySupRosterBreakout(t).SupDEROS
        'Constant cells headings
        X = X + 1
        ' The below 7 lines need to be bold, filled gray, thick line border all sides
        Cells(X, 1).Value = "Name"
        Cells(X, 2).Value = "Supervision Start Date"
        Cells(X, 3).Value = "# Days Supervised"
        Cells(X, 4).Value = "# Days Supervised at DEROS"
        Cells(X, 5).Value = "EPR Closeout"
        Cells(X, 6).Value = "Days Until Closeout"
        Cells(X, 7).Value = "Duty Title"
        X = X + 1
        'run through each entry to see if supid matches the above sup
        'tx stands for troop from above and x var
        txCount = 0
        For tx = LBound(ArraySupRosterBreakout) To UBound(ArraySupRosterBreakout)
            If ArraySupRosterBreakout(tx).SupID = ArraySupRosterBreakout(t).SupID Then
                'format odd and even for fill no fill, count times this is run for troop count at top of table
                'add a switch if even fill color gray
                'all cells will have border of think line on both sides
                'last cell in list will have border thick line on bottom

                Cells(X, 1).Value = ArraySupRosterBreakout(tx).TroopRank & " " & ArraySupRosterBreakout(tx).TroopName
                Cells(X, 2).Value = ArraySupRosterBreakout(tx).SupStartDate
                Cells(X, 3).Value = ArraySupRosterBreakout(tx).NoDaySup
                Cells(X, 4).Value = ArraySupRosterBreakout(tx).NoDaySupDEROS
                Cells(X, 5).Value = ArraySupRosterBreakout(tx).EPRCloseout
                Cells(X, 6).Value = ArraySupRosterBreakout(tx).DaysUntilCloseout
                Cells(X, 7).Value = ArraySupRosterBreakout(tx).DutyTitle
                X = X + 1
                txCount = txCount + 1
            End If
        Next tx
        Cells(txCountLocation, 3).Value = txCount


        X = X + 1
        t = t + txCount
    Next t
End Sub

Open in new window

0
 
LVL 2

Accepted Solution

by:
Chris Pfeiffer earned 0 total points
ID: 39608640
Here is the final code I used to included formatting.  Its not clean so if anyone wants to clean it up be my guest.

Sub GenBreakoutRoster()
' ------only need the below if you are not opening in a new workbook
    Sheet19.Activate
    Cells.Select
    Selection.Delete
    Dim memberCount As Integer
    Dim SupName As String, SelectedSupName As String
    Dim SupNameLen As Integer, SelectedSupNameLen As Integer
    Dim xTroop As Integer   'increment the supervisor array
    xTroop = 0

    Dim SupIDKey As String  'This is the place holder for the SupID in the ArraySupRosterBreakout will be SSN
    Dim SupFullName As String    ' This will have the Sup Name and Rank for the heading

    LoadArray.LoadAlphaRosterArray
    Sheet4.Activate
    memberCount = Cells(Rows.count, "A").End(xlUp).Row
    ReDim ArraySupRosterBreakout(memberCount)

    For x = LBound(ArrayMemberData) To UBound(ArrayMemberData)
        SupIDKey = ArrayMemberData(x).SSAN
        SupFullName = ArrayMemberData(x).Grade & " " & ArrayMemberData(x).Full_Name
        SelectedSupName = ArrayMemberData(x).Full_Name
        SelectedSupName = UCase(Replace(SelectedSupName, " ", ""))
        SelectedSupName = Replace(SelectedSupName, ",", "")
        SelectedSupNameLen = Len(SelectedSupName)

        For i = LBound(ArrayMemberData) To UBound(ArrayMemberData)
            SupName = ArrayMemberData(i).Supv_Name
            SupName = UCase(Replace(SupName, " ", ""))
            SupName = Replace(SupName, ",", "")
            SupNameLen = Len(SupName)

            If SupNameLen <> 0 Then
                If Left(SupName, SupNameLen) = Left(SelectedSupName, SupNameLen) Then
                    ArraySupRosterBreakout(xTroop).SupID = SupIDKey
                    ArraySupRosterBreakout(xTroop).SupName = SupFullName
                    ArraySupRosterBreakout(xTroop).TroopRank = ArrayMemberData(i).Grade
                    ArraySupRosterBreakout(xTroop).TroopName = ArrayMemberData(i).Full_Name
                    ArraySupRosterBreakout(xTroop).SupStartDate = ArrayMemberData(i).Supv_Begin_Date
                    ArraySupRosterBreakout(xTroop).NoDaySup = CDate(Date) - CDate(ArrayMemberData(i).Supv_Begin_Date)    ' number of days under current supervision
                    ArraySupRosterBreakout(xTroop).NoDaySupDEROS = CDate(ArrayMemberData(x).DEROS) - CDate(ArrayMemberData(i).Supv_Begin_Date)  ' add the time between SupStartDate and DEROS of SUP
                    ArraySupRosterBreakout(xTroop).EPRCloseout = ArrayMemberData(i).Proj_Eval_Close_Date
                    ArraySupRosterBreakout(xTroop).DaysUntilCloseout = CDate(ArrayMemberData(i).Proj_Eval_Close_Date) - CDate(Date)    'days until closeout
                    ArraySupRosterBreakout(xTroop).DutyTitle = ArrayMemberData(i).Duty_Title
                    ArraySupRosterBreakout(xTroop).SupDEROS = ArrayMemberData(x).DEROS
                    ArrayMemberData(i).Row = "1"
                    xTroop = xTroop + 1
                End If

            End If
        Next i
    Next x

    'Temp solution for filling the roster to sendout
    Sheet19.Activate


    Dim trigger As Integer    ' tells when the supervisor changes and when to start a new table
    Dim t As Integer    ' ArraySupRosterBreakout indexer
    Dim txCountLocation As Integer
    Dim txCount As Integer    ' number of troops under each sup.
    'this is added to the t count to get the next sup as well.
    x = 1
    txCount = 0
    For t = LBound(ArraySupRosterBreakout) To UBound(ArraySupRosterBreakout)
        'Highlight Supervisor and make them BOLD
        Cells(x, 1).Value = ArraySupRosterBreakout(t).SupName

        If ArraySupRosterBreakout(t).SupName = "" Then
            txCountLocation = x
            Cells(x, 2).Value = "Number of Troops: "
            Cells(x, 2).Font.Bold = True
            Cells(x, 2).HorizontalAlignment = xlRight
            x = x + 1
            GoTo NoSup
        End If
        Cells(x, 1).Interior.Color = 65535
        Cells(x, 1).Font.Bold = True

        'Bold Cell and right aligin text
        Cells(x, 2).Value = "Number of Troops: "
        Cells(x, 2).Font.Bold = True
        Cells(x, 2).HorizontalAlignment = xlRight

        'Bold Cell and right aligin text
        Cells(x, 5).Value = "DEROS: "
        Cells(x, 5).Font.Bold = True
        Cells(x, 5).HorizontalAlignment = xlRight

        'Bold Cell and left aligin text
        Cells(x, 6).Value = ArraySupRosterBreakout(t).SupDEROS
        Cells(x, 6).Font.Bold = True
        Cells(x, 6).HorizontalAlignment = xlLeft

        ' this will store the location the txCount value will go to add total troop count Cells(X, 3).Value = "XX"    ' ADD THE NUMBER OF TIMES THE TROOPS CYCLE RUNS.
        txCountLocation = x

        'Constant cells headings
        x = x + 1
        ' The below 7 lines need to be bold, filled gray, thick line border all sides
        Cells(x, 1).Value = "Name"
        Cells(x, 2).Value = "Supervision Start Date"
        Cells(x, 3).Value = "# Days Supervised"
        Cells(x, 4).Value = "# Days Supervised at DEROS"
        Cells(x, 5).Value = "EPR Closeout"
        Cells(x, 6).Value = "Days Until Closeout"
        Cells(x, 7).Value = "Duty Title"
        Range(Cells(x, 1), Cells(x, 7)).Select
        Selection.Font.Bold = True
        Selection.Interior.Color = 8421504

        With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With

        'dump names with no supervisor
NoSup:
        x = x + 1
        'run through each entry to see if supid matches the above sup
        'tx stands for troop from above and x var
        txCount = 0


        For tx = LBound(ArraySupRosterBreakout) To UBound(ArraySupRosterBreakout)
            If ArraySupRosterBreakout(tx).SupID = ArraySupRosterBreakout(t).SupID Then
                'format odd and even for fill no fill, count times this is run for troop count at top of table
                'add a switch if even fill color gray
                'all cells will have border of think line on both sides
                'last cell in list will have border thick line on bottom

                Cells(x, 1).Value = ArraySupRosterBreakout(tx).TroopRank & " " & ArraySupRosterBreakout(tx).TroopName
                Cells(x, 2).Value = ArraySupRosterBreakout(tx).SupStartDate
                Cells(x, 3).Value = ArraySupRosterBreakout(tx).NoDaySup
                
                'highlight 120 days supervision or more EPR Required
                If Cells(x, 3).Value >= 120 Then
                    Cells(x, 3).Select
                    With Selection
                        .Font.Bold = True
                        .Font.Underline = xlUnderlineStyleSingle
                    End With
                End If
                
                Cells(x, 4).Value = ArraySupRosterBreakout(tx).NoDaySupDEROS
                Cells(x, 5).Value = ArraySupRosterBreakout(tx).EPRCloseout
                Cells(x, 6).Value = ArraySupRosterBreakout(tx).DaysUntilCloseout
                  If Cells(x, 6).Value < 0 Then
                    Cells(x, 6).Font.Bold = True
                    Cells(x, 6).Select
                    With Selection.Interior
                        .Color = 255
                    End With
                End If
                Cells(x, 7).Value = ArraySupRosterBreakout(tx).DutyTitle

                Range(Cells(x, 1), Cells(x, 7)).Select
                'If an odd row shade it light gray
                If IsOdd(txCount) Then
                    Selection.Interior.Color = 14540253
                End If
                'add borders to both sides of the table
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With

                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With

                With Selection.Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = xlAutomatic
                End With

                x = x + 1
                txCount = txCount + 1

            End If

        Next tx

        'Add a border to the bottom of the last row using the last x value
        Range(Cells(x, 1), Cells(x, 7)).Select
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With

        'Format cell to BOLD and align left to match above formatting
        Cells(txCountLocation, 3).Value = txCount
        Cells(txCountLocation, 3).Font.Bold = True
        Cells(txCountLocation, 3).HorizontalAlignment = xlLeft

        x = x + 1
        t = t + txCount
    Next t
    'List all members who do not have a supervisor listed on our Alpha Roster
    x = Cells(Rows.count, 7).End(xlUp).Row

    'Autofit Col without long heading for "No Supervisors".
    Columns("A:A").ColumnWidth = 28.43
    Columns("A:A").ColumnWidth = 33
    Columns("A:A").EntireColumn.AutoFit    'ColumnWidth = 29.71
    Columns("B:B").EntireColumn.AutoFit    'ColumnWidth = 19.71
    Columns("C:C").EntireColumn.AutoFit    'ColumnWidth = 16.14
    Columns("D:D").EntireColumn.AutoFit    'ColumnWidth = 24
    Columns("D:D").EntireColumn.AutoFit    'ColumnWidth = 25.29
    Columns("D:D").EntireColumn.AutoFit    'ColumnWidth = 24.43
    Columns("E:E").EntireColumn.AutoFit    'ColumnWidth = 11.86
    Columns("F:F").EntireColumn.AutoFit    'ColumnWidth = 17.57
    Columns("G:G").EntireColumn.AutoFit

    x = x + 2
    Cells(x, 1).Value = "Members without Supervisors listed in our squadron"
    Cells(x, 2).Value = "Number of troops:"
    Cells(x, 3).Value = ""
    Cells(x, 4).Value = ""
    Cells(x, 5).Value = ""
    Cells(x, 6).Value = ""
    Cells(x, 7).Value = ""


    'Add the table headers for members with no supervisor
    'Cells(X, 1).Value = "Rank and Name"
    'Cells(X, 2).Value = "Date Arrive @ Osan"
    'Cells(X, 3).Value = "Supervisor"
    'Cells(X, 4).Value = "Duty Title"

    
    Dim noSups As Integer, xCountLocation As Integer
    noSups = 0
    xCountLocation = x
    x = x + 1
    For i = LBound(ArrayMemberData) To UBound(ArrayMemberData)
        If ArrayMemberData(i).Row <> "1" Then
            Cells(x, 1).Value = ArrayMemberData(i).Grade & " " & ArrayMemberData(i).Full_Name
            Cells(x, 2).Value = ArrayMemberData(i).Date_Arrived_Station
            Cells(x, 4).Value = ArrayMemberData(i).Supv_Name
            Cells(x, 7).Value = ArrayMemberData(i).Duty_Title
            x = x + 1
            noSups = noSups + 1
        End If
    Next i
    Cells(xCountLocation, 3).Value = noSups
End Sub

Function IsOdd(x As Integer) As Boolean
    IsOdd = (x Mod 2) <> 0
End Function

Open in new window

0
 
LVL 2

Author Closing Comment

by:Chris Pfeiffer
ID: 39619677
I was able to work through the issue I was having without help from EE members
0

Featured Post

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

749 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question