Results 1 to 14 of 14
  1. #1
    5 Star Lounger Lou Sander's Avatar
    Join Date
    Jun 2002
    Location
    Pittsburgh, PA
    Posts
    855
    Thanks
    140
    Thanked 10 Times in 9 Posts

    Finding First and Last Items

    I have a worksheet with about 9,000 rows. Each row applies to one of about 250 Navy ships.

    Each row has eight columns, three of them important: ShipName, Month, and Year. All are in the General format. Month is spelled-out text for the name of the month. The rows are currently sorted alphabetically by ShipName, then Month, then Year. The months are sorted non-alphabetically: January, February, May, July, etc. (there's not an entry for every month in every year).

    I want to make a new worksheet that shows, for each ship, its ShipName, the first and last Month and Year that have entries in the original list. It would be something like

    USS Neversail (DD-214) January 1966 October 1969
    USS November (CA-12) February 1965 December 1970
    etc.

    The "January 1966" would be taken from the first entry for USS Neversail (DD-214), and "October 1969" would be taken from the last one.

    It seems as though this should be easy in Excel, but I have no idea where to start.
    Lou Sander
    Pittsburgh, Pennsylvania
    USA

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    Hi Lou,

    I did this by writing some code that blends the insertion of array formulas into cells along with search code to create a list of unique ships with their first and last dates on a new worksheet.

    HTH,
    Maud

    Original data (Sheet 1)
    Lou1.png

    Formatted data (Sheet 2)
    Lou3.png

    Code:
    Sub UniqueShips()
    '--------------------------------
    'DECLARE AND SET VARIABLES
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim NavyShips As New Collection, ship
        Dim Ships() As Variant
        Dim I As Long, LastRow As Long, EndRow As Long
        Set ws1 = Worksheets("Sheet1")
        Set ws2 = Worksheets("Sheet2")
        Ships = ws1.Range("A2:A9")
    '--------------------------------
    'CREATE COLLECTION OF UNIQUE SHIPS FROM SHEET 1
        On Error Resume Next
        For Each ship In Ships
           NavyShips.Add ship, ship
        Next
    '--------------------------------
    'WRITE UNIQUE SHIPS TO SHEET 2
        For I = 1 To NavyShips.count
           Worksheets("Sheet2").Cells(I + 1, 1) = NavyShips(I)
        Next
    '--------------------------------
    'GET DATA
        EndRow = ws1.Cells(Rows.count, 1).End(xlUp).Row
        LastRow = ws2.Cells(Rows.count, 1).End(xlUp).Row
        For I = 2 To LastRow
    '--------------------------------
    'INSERT MIN/MAX ARRAY FORMULAS FOR YEARS
            ws2.Cells(I, 3).FormulaArray = "=MIN(IF(Sheet1!A2:A9=Sheet2!A" & I & ",Sheet1!C2:C9))"
            ws2.Cells(I, 5).FormulaArray = "=MAX(IF(Sheet1!A2:A9=Sheet2!A" & I & ",Sheet1!C2:C9))"
    '--------------------------------
    'SEARCH FOR MONTH
            For J = 2 To EndRow
                If ws2.Cells(I, 1) = ws1.Cells(J, 1) And ws2.Cells(I, 3) = ws1.Cells(J, 3) Then
                    ws2.Cells(I, 2) = ws1.Cells(J, 2)
                End If
                If ws2.Cells(I, 1) = ws1.Cells(J, 1) And ws2.Cells(I, 5) = ws1.Cells(J, 3) Then
                    ws2.Cells(I, 4) = ws1.Cells(J, 2)
                End If
            Next J
        Next I
    '--------------------------------
    'CLEANUP
    Set NavyShips = Nothing
    Erase Ships
    Set ws1 = Nothing
    Set ws2 = Nothing
    End Sub
    Attached Files Attached Files

  3. #3
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,179
    Thanks
    47
    Thanked 983 Times in 913 Posts
    Shouldn't you have these written like this?

    'WRITE UNIQUE SHIPS TO SHEET 2
    For I = 1 To NavyShips.count
    ws2.Cells(I + 1, 1) = NavyShips(I)


    'INSERT MIN/MAX ARRAY FORMULAS FOR YEARS
    ws2.Cells(I, 3).FormulaArray = "=MIN(IF(ws1.Name!A2:A9=ws2.Name!A" & I & ",ws1.Name!C2:C9))"
    ws2.Cells(I, 5).FormulaArray = "=MAX(IF(ws1.Name!A2:A9=ws2.Name!A" & I & ",ws1.Name!C2:C9))"

    cheers, Paul

  4. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    Keen eye Paul! Yep, that's what I dimmed ws1/ws2 for however, it will still work fine as posted. ws1.Name cannot be included in the quotes as you have them.

    Maud

  5. #5
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,179
    Thanks
    47
    Thanked 983 Times in 913 Posts
    Thought as much, but I don't have Office to test so just left it in that format. (anyone got a free version of Office I can use for testing?)

    cheers, Paul

  6. #6
    5 Star Lounger Lou Sander's Avatar
    Join Date
    Jun 2002
    Location
    Pittsburgh, PA
    Posts
    855
    Thanks
    140
    Thanked 10 Times in 9 Posts
    I just got up, and this was the first thing I looked at. It looks good so far. I'll try it once my motor gets started and I have a little breakfast.

    I don't know that it makes any difference, but the original worksheet is sorted from month to month by ship. In other words, all the USS Neversail entries are together, with January of year 1 first, then February of year 1, on to December of year N.
    Last edited by Lou Sander; 2015-11-29 at 09:03. Reason: Clarify
    Lou Sander
    Pittsburgh, Pennsylvania
    USA

  7. #7
    5 Star Lounger Lou Sander's Avatar
    Join Date
    Jun 2002
    Location
    Pittsburgh, PA
    Posts
    855
    Thanks
    140
    Thanked 10 Times in 9 Posts
    Oops! When I pasted in the "real" data, it didn't work. Probably some errer on this end. I used Maud's original code.

    Attached is your example with the "real" data.
    Attached Files Attached Files
    Last edited by Lou Sander; 2015-11-29 at 10:36.
    Lou Sander
    Pittsburgh, Pennsylvania
    USA

  8. #8
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,179
    Thanks
    47
    Thanked 983 Times in 913 Posts
    Assuming I still remember my VBA, it should look like this.

    'INSERT MIN/MAX ARRAY FORMULAS FOR YEARS
    ws2.Cells(I, 3).FormulaArray = "=MIN(IF(" & ws1.Name & "!A2:A9=" & ws2.Name & "!A" & I & "," & ws1.Name & "!C2:C9))"
    ws2.Cells(I, 5).FormulaArray = "=MAX(IF(" & ws1.Name & "!A2:A9=" & ws2.Name& "!A" & I & "," & ws1.Name & "!C2:C9))"

    cheers, Paul

  9. #9
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    Lou,

    I wouldn't have expected you to know this but the code was set to test the first 9 lines. That is why there is only one ship on sheet 2. Change to the following lines in red and it will run nicely. Sorry I left out such an important piece of information but sometimes I assume people to know what I am thinking. These numbers need to be changed if the number of rows change as well. I could have modified it to use a variable but hind site is 20/20.

    Maud

    Code:
    Sub UniqueShips()
    '--------------------------------
    'DECLARE AND SET VARIABLES
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim NavyShips As New Collection, ship
        Dim Ships() As Variant
        Dim I As Long, LastRow As Long, EndRow As Long
        Set ws1 = Worksheets("Sheet1")
        Set ws2 = Worksheets("Sheet2")
        Ships = ws1.Range("A2:A9164")
    '--------------------------------
    'CREATE COLLECTION OF UNIQUE SHIPS FROM SHEET 1
        On Error Resume Next
        For Each ship In Ships
           NavyShips.Add ship, ship
        Next
    '--------------------------------
    'WRITE UNIQUE SHIPS TO SHEET 2
        For I = 1 To NavyShips.count
           Worksheets("Sheet2").Cells(I + 1, 1) = NavyShips(I)
        Next
    '--------------------------------
    'GET DATA
        EndRow = ws1.Cells(Rows.count, 1).End(xlUp).Row
        LastRow = ws2.Cells(Rows.count, 1).End(xlUp).Row
        For I = 2 To LastRow
    '--------------------------------
    'INSERT MIN/MAX ARRAY FORMULAS FOR YEARS
            ws2.Cells(I, 3).FormulaArray = "=MIN(IF(Sheet1!A2:A9164=Sheet2!A" & I & ",Sheet1!C2:C9164))"
            ws2.Cells(I, 5).FormulaArray = "=MAX(IF(Sheet1!A2:A9164=Sheet2!A" & I & ",Sheet1!C2:C9164))"
    '--------------------------------
    'SEARCH FOR MONTH
            For J = 2 To EndRow
                If ws2.Cells(I, 1) = ws1.Cells(J, 1) And ws2.Cells(I, 3) = ws1.Cells(J, 3) Then
                    ws2.Cells(I, 2) = ws1.Cells(J, 2)
                End If
                If ws2.Cells(I, 1) = ws1.Cells(J, 1) And ws2.Cells(I, 5) = ws1.Cells(J, 3) Then
                    ws2.Cells(I, 4) = ws1.Cells(J, 2)
                End If
                
    
            Next J
        Next I
    '--------------------------------
    'CLEANUP
    Set NavyShips = Nothing
    Erase Ships
    Set ws1 = Nothing
    Set ws2 = Nothing
    End Sub
    
    Sub ClearSheet()
        LastRow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
        Range("A2:E" & LastRow).ClearContents
        Range("A2").Select
    End Sub
    Looks more like it Paul!

  10. #10
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    BTW, it took me about 20 seconds (nested loops) for the code to complete ending up with 234 unique ships on sheet 2. As you may have guessed, I had been working on this using formulas alone but turned to VBA because I was struggling with a formula to find the month. Thinking of it now, the ROW function combined with the MIN/MAX functions might have worked.

    Maud
    Last edited by Maudibe; 2015-11-29 at 11:05.

  11. #11
    5 Star Lounger Lou Sander's Avatar
    Join Date
    Jun 2002
    Location
    Pittsburgh, PA
    Posts
    855
    Thanks
    140
    Thanked 10 Times in 9 Posts
    Close, but no cigar. I made the changes as I understood them (not all were in red, so maybe I missed something).

    There is something fishy about the first month in each range of logbooks. A lot of them show up as December on Sheet2, regardless of the month shown on Sheet1.

    For example, Abbot (DD-629) entries go from January 1961 through March 1965 on Sheet1. Sheet2 shows them as December 1961 through March 1965.

    Albatross (MSC-289) is OK, but only has two entries in Sheet1. A few others don't show December as the first month.

    A copy of my revised workbook is attached.

    BTW, this bit of work is pretty important in the larger scheme of things. It has to do with people who were aboard U.S. Navy ships in Vietnam, and who are suffering the effects of Agent Orange exposure, or think they might be. (Agent Orange is a nasty carcinogen that wasn't recognized as such at the time.) Navy records don't show where a particular man's ship was while in Vietnamese waters, so it is just assumed that he wasn't in any Agent Orange area. If a man wants to make a claim with the Veterans Administration, it is up to him to show that his ship was in such an area while he was aboard. The way to do that is to consult the ship's Deck Log for the period the guy was aboard.

    To facilitate this, the National Archives has scanned and put online many deck logs from the period (the task is ongoing). So far they have scanned about 40 pages for each of the 9,164 entries on Sheet1, or about 360,000 pages. I've spent time looking through logs in the Archives, and believe me, it is a BIG job to retrieve that many records and to prepare them for scanning, let alone to actually scan them.

    Sheet1 is a subset of a sheet with eight columns, provided to me by a guy who is helping Agent Orange victims. I think the people at the Archives sent it to him. The extra columns include technical information about the material at the National Archives, including hyperlinks to the actual online log pages. A typical monthly log is HERE.

    The sheet we are working on is intended to let people know the full extent of the logs that have been scanned so far. So if you were aboard USS Abbott (DD-629), you can consult my/our little index and tell if there's an online log for your time aboard. As time goes on, Sheet1 will keep growing.

    Given that Sheet1 will grow over time, maybe it would be useful if I'd convert the non-Excel-like "January" and "1961" to something that Excel can handle more easily. I think that's in my pay grade to do.
    Attached Files Attached Files
    Lou Sander
    Pittsburgh, Pennsylvania
    USA

  12. #12
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    OK, Lou. I think I resolved the month issue.

    Lou4.png
    Code:
    Here is the revised code (blue) and your worksheet with the changes applied.
    
    Sub UniqueShips()
    '--------------------------------
    'DECLARE AND SET VARIABLES
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim NavyShips As New Collection, ship, s(), t()
        Dim Ships() As Variant
        Dim I As Long, LastRow As Long, EndRow As Long
        Dim sCount As Integer, tCount As Integer
        Set ws1 = Worksheets("Sheet1")
        Set ws2 = Worksheets("Sheet2")
        Ships = ws1.Range("A2:A9164")  'Needs to be set to the last row in the range
    '--------------------------------
    'CREATE COLLECTION OF UNIQUE SHIPS FROM SHEET 1
        On Error Resume Next
        For Each ship In Ships
           NavyShips.Add ship, ship
        Next
    '--------------------------------
    'WRITE UNIQUE SHIPS TO SHEET 2
        For I = 1 To NavyShips.count
           Worksheets("Sheet2").Cells(I + 1, 1) = NavyShips(I)
        Next
    '--------------------------------
    'GET DATA
        EndRow = ws1.Cells(Rows.count, 1).End(xlUp).Row
        LastRow = ws2.Cells(Rows.count, 1).End(xlUp).Row
        For I = 2 To LastRow
    '--------------------------------
    'INSERT MIN/MAX ARRAY FORMULAS FOR YEARS
            ws2.Cells(I, 3).FormulaArray = "=MIN(IF(Sheet1!A2:A9164=Sheet2!A" & I & ",Sheet1!C2:C9164))" 'Needs to be set to the last row in the range
            ws2.Cells(I, 5).FormulaArray = "=MAX(IF(Sheet1!A2:A9164=Sheet2!A" & I & ",Sheet1!C2:C9164))" 'Needs to be set to the last row in the range
    '--------------------------------
    'SEARCH FOR MONTH
            For J = 2 To EndRow
    '--------------------------------
    'MIN MONTH
                If ws2.Cells(I, 1) = ws1.Cells(J, 1) And ws2.Cells(I, 3) = ws1.Cells(J, 3) Then
                    ReDim Preserve s(sCount)
                    s(sCount) = Month(DateValue("01-" & ws1.Cells(J, 2) & "-1900"))
                    sCount = sCount + 1
                End If
    '--------------------------------
    'MAX MONTH
                If ws2.Cells(I, 1) = ws1.Cells(J, 1) And ws2.Cells(I, 5) = ws1.Cells(J, 3) Then
                    ReDim Preserve t(tCount)
                    t(tCount) = Month(DateValue("01-" & ws1.Cells(J, 2) & "-1900"))
                    tCount = tCount + 1
                End If
            Next J
                ws2.Cells(I, 2) = MonthName(WorksheetFunction.Min(s()))
                ws2.Cells(I, 4) = MonthName(WorksheetFunction.Max(t()))
                sCount = 0: tCount = 0
        Next I
    '--------------------------------
    'CLEANUP
    Set NavyShips = Nothing
    Erase Ships
    Set ws1 = Nothing
    Set ws2 = Nothing
    End Sub
    Attached Files Attached Files
    Last edited by Maudibe; 2015-11-29 at 21:16.

  13. The Following User Says Thank You to Maudibe For This Useful Post:

    Lou Sander (2015-11-30)

  14. #13
    5 Star Lounger Lou Sander's Avatar
    Join Date
    Jun 2002
    Location
    Pittsburgh, PA
    Posts
    855
    Thanks
    140
    Thanked 10 Times in 9 Posts
    Maud,

    I believe you are right. The VBA seems to be doing exactly what it needs to do. Thanks, and BZ. (Bravo Zulu = Navy talk for "well done")

    Just to show that I AM able to do Excel work on my own, I've converted the text-based date ranges into something that Excel can handle. Sheet2 of the attached workbook shows the first and last days of the range of dates for each ship. It even handles February in leap years. (NOTE: the attached workbook is REV05, which replaces a previously uploaded one.)

    Now there's an easy-to-use "finding aid" for 360,000 online pages of scanned deck logs. Pretty good, I say.
    Attached Files Attached Files
    Last edited by Lou Sander; 2015-11-30 at 11:10. Reason: Replace attached file
    Lou Sander
    Pittsburgh, Pennsylvania
    USA

  15. #14
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    Nicely done Lou! And thanks for the commented credit in the code
    Last edited by Maudibe; 2015-11-30 at 17:48.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •