Consulting

Results 1 to 6 of 6

Thread: Highest Values to the New Sheet

  1. #1
    VBAX Regular
    Joined
    Aug 2012
    Posts
    8
    Location

    Highest Values to the New Sheet

    Hello Guys,

    Can any one help me on this below situation.

    I have a work book, it contains many columns, each row has a unique number, The rows are nearly 40k.

    In this situaiton, I need only the Highest Number row in to another sheet. So, I need a macro to do this job. Is it possible?

    Please see the attachemnt, so you will understand what i need exactly.

    Thank you In Advance.
    Attached Files Attached Files

  2. #2
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    Greetings Ctrl+s,

    Try:
    [vba]Option Explicit

    Sub example()
    Dim DIC As Object '<---Dictionary
    Dim aryInputVals As Variant
    Dim aryKeys As Variant
    Dim aryDics As Variant
    Dim aryOutput As Variant
    Dim n As Long

    Set DIC = CreateObject("Scripting.Dictionary")

    With Sheet1 '<---Use CodeName, OR, use tab name---> ThisWorkbook.Worksheets("The name on the tab")
    '// Your example shows only one column of data, so this grabs the values and//
    '// plunks them into an array. //
    aryInputVals = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
    End With

    '// Run through the values... //
    For n = 1 To UBound(aryInputVals, 1)
    '// ...checking to make sure they have one and only one dash in each... //
    If InStr(1, aryInputVals(n, 1), "-") > 0 _
    And Len(aryInputVals(n, 1)) - 1 _
    = Len(Replace(aryInputVals(n, 1), "-", vbNullString)) Then

    '// ...and if so, split the what's on the left from the right. //
    aryOutput = Split(aryInputVals(n, 1), "-")

    '// If the left value (like '0051') isn't a .Key yet... //
    If Not DIC.Exists(aryOutput(0)) Then
    '// ... add it, while setting reference to a "child" dictionary held//
    '// as the .Key's .Item. //
    Set DIC.Item(aryOutput(0)) = CreateObject("Scripting.Dictionary")
    If IsNumeric(aryOutput(1)) Then
    '// Then we just add what's on the right side of the dash as a //
    '// .Key in the "child" dictionary, as we don't care if any are //
    '// overwritten, since we are just looking for the max value. //
    DIC.Item(aryOutput(0)).Item(CLng(aryOutput(1))) = Empty
    End If
    Else
    If IsNumeric(aryOutput(1)) Then
    DIC.Item(aryOutput(0)).Item(CLng(aryOutput(1))) = Empty
    End If
    End If
    End If
    Next

    aryKeys = DIC.Keys
    aryDics = DIC.Items

    '// Reconfigure our array to hold the results. //
    ReDim aryOutput(1 To UBound(aryKeys) - LBound(aryKeys) + 1, 1 To 1)

    For n = LBound(aryKeys) To UBound(aryKeys)
    aryOutput(n + 1, 1) _
    = aryKeys(n) & "-" & Format(Application.Max(aryDics(n).Keys), "00")
    Next
    '// Plunk the output somewheres. //
    Sheet1.Range("D2").Resize(UBound(aryOutput, 1)).Value = aryOutput
    End Sub[/vba]

    Hope that helps,

    Mark

  3. #3
    VBAX Regular
    Joined
    Aug 2012
    Posts
    8
    Location
    Thank you so much

    Is it possible to place the result in Sheet 2?
    Last edited by Bob Phillips; 08-14-2012 at 01:20 AM. Reason: Removed superfluous quoting

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,646
    or
    [vba]Sub snb()
    sn = Sheet1.Columns(1).SpecialCells(2).Resize(, 2)

    y = 2
    c01 = Left(sn(2, 1), 4)
    For j = 3 To UBound(sn)
    If Left(sn(j, 1), 4) = c01 Then
    If Val(Right(sn(j, 1), 2)) > 0 Then sn(y, 2) = Application.Max(sn(y, 2), Right(sn(j, 1), 2))
    Else
    sn(y, 2) = c01 & " " & sn(y, 2)
    c01 = Left(sn(j, 1), 4)
    y = y + 1
    End If
    Next
    sn(y, 2) = c01 & " " & sn(y, 2)

    Sheet2.Cells(1).Resize(UBound(sn)) = Application.Index(sn, , 2)
    End Sub[/vba]

  5. #5
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    Quote Originally Posted by Ctrl+s
    Thank you so much

    Is it possible to place the result in Sheet 2?
    You are most welcome and glad it seems to be working.

    Of course you can plunk the array wherever you want (not to surpass a sheet's "edges" of course). Whether snb's code, mine, another's, or eventually, your own's, turns out to best suit your needs, I would suggest stepping through the code and reading help on each method/function/etc.

    It may seem daunting at first, but as long as you keep Option Explicit at the top of each Module, intellisence (which I have mis-spelled three times now and am giving up) is a big help and so are the Local and Immediate Windows (with Debug.Print for the latter).

    Anyways, in the last bit of the procedure, just change where we dump the array to:

    [vba]'...code...
    '// Using "Sheet2"'s default CodeName: //
    '// Sheet2.Range("A1").Resize(UBound(aryOutput, 1)).Value = aryOutput //
    '// OR: //
    ThisWorkbook.Worksheets("My Sheet's Name").Range("A1") _
    .Resize(UBound(aryOutput, 1)).Value = aryOutput
    End Sub
    [/vba]

    Hope that helps ,

    Mark

  6. #6
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    ...a correction, based on a valid "head's up" PM from snb:

    Declaration of the variables used is what "fires up" Intellisense, not Option Explicit requiring declaration of said.

    That said, I would sincerely suggest the inclusion of Option Explicit. Simply put - it saves headaches. In my simple way of thinking about it, it is the nearest thing to SpellCheck for code. Since VBIDE (or whatever library) must be able to precisely read what you are telling it to do, catching any of my instructional mistakes seems like a good idea to me.

Posting Permissions

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