Help on finding duplicates loop

[poobs_away]

Not entirely sure how to title what I need doing, so I hope the one I chose is alright. I'm fairly new to VBA, so I don't know much, and this is my first post here.

OK, this is a bit complicated, so let me set up an example of what I'm dealing with before I go on to explain what I need in the macro. Say I have a list of names in column a, some of them being the same; in column B I have numbers corresponding to those names:

john 21
john 14
lee 57
gary 12

except think along the lines of 500 or so rows of this. What I need to do is have a macro that starts at cell A1 looks at the name inside, then searches the rest of the column for duplicates. Once it's done that, it needs to go over to the B column and enter in all the numbers from the duplicate names it found into an equation, which for now will be just adding them up. Next it needs to take that sum and store it as a variable somewhere for future use in another macro(as I'll need to eventually plug these numbers into a larger equation. Definitely unsure if this part is possible), something like a=35, b=57, c=12.Finally it needs to note which cells it used in A so that when it loops to the next name it doesn't go to, in this case, a2 and find john again, but a3 to find lee. It would loop like this, adding up all the duplicates and assigning everything variables until it reaches a blank cell which would stop it.

Note that I don't want these variables to replace the current table, just to store them in the background somewhere for future use so that I could do something like a^2, which was john's variable in this example, and get 35x35.

I hope I explained this well enough, I don't know how much of this is actually possible, but anything is better than what I have right now, which is absolutely nothing.

 

[Marcelo Branco]

Hi,

Welcome to the forum!

Some questions:
Excel version?
Could you use some columns of your worksheet as helper-columns?

M.

 

[poobs_away]

I have excel 2010. As far as the helper columns, do you mean columns down the line somewhere that can be used to temporarily store information while the macro is working stuff out? If that's the case, I probably can, but they'd be off in the double letter columns somewhere. It's a pretty big table

 

[poobs_away]

also, if a helper column is what I think it is, couldn't it be located on a separate sheet?

 

[Jon von der Heyden]

Welcome to the board.

The following is a rough-around-the-edges function that returns an array. The 1st D of the array houses the name, and the 2nd D holds an array of the associated values (so it is a jagged array). Each item refers to a distinct name.

When you call the function you must pass it a 2 column range. It expects the 1st column to be the names and the 2nd to be the vals. Also expects column headers in the first row of the range reference.

Public Function NameVals(ByVal rngTable As Range) As Variant
    Dim varDistinctNames As Variant
    Dim varVals As Variant
    Dim strVals As String
    Dim lngItem As Long
    Dim objDic As Object: Set objDic = CreateObject("Scripting.Dictionary")
    Dim rngCell As Range
    
    If rngTable.Columns.Count <> 2 Then
        MsgBox "Expect 2 column range"
        Exit Function
    End If
    
    For Each rngCell In rngTable.Resize(, 1)
        If Not objDic.exists(rngCell.Value) Then
            objDic.Add rngCell.Value, rngCell.Value
        End If
    Next rngCell
    
    rngTable.Parent.AutoFilterMode = False
    
    varDistinctNames = objDic.keys
    ReDim varVals(1 To UBound(varDistinctNames), 1 To 2)
    
    For lngItem = LBound(varDistinctNames) + 1 To UBound(varDistinctNames)
        strVals = vbNullString
        With rngTable
            .AutoFilter Field:=1, Criteria1:=varDistinctNames(lngItem)
            varVals(lngItem, 1) = varDistinctNames(lngItem)
            For Each rngCell In rngTable.Offset(, 1).Resize(, 1)
                If rngCell.Offset(, -1).Value = varDistinctNames(lngItem) Then
                    strVals = strVals & ";" & rngCell.Value
                End If
            Next rngCell
            strVals = Mid$(strVals, 2)
            varVals(lngItem, 2) = Split(strVals, ";")
            .AutoFilter
        End With
    Next lngItem
    
    NameVals = varVals
        
End Function

 

[poobs_away]

Cool. Tried it out and it seems like it's doing something. I won't need the values printed in the long run, but is there a way to look at the array I created just to make sure it's doing what it's supposed to do as well as find out what the variables it set for the names are.

 

[poobs_away]

Also I should say thank you SOOOOO much for essentially doing my job for me. You've essentially just written the code for the cornerstone in this project, something that would've taken me weeks to do, and that wouldn't have looked half as good as what you've given me. Now all I have to do is work backwards through this code to learn what it's doing so I can modify it for the real thing.

thank you thank you thank you!

 

[Jon von der Heyden]

Hi

I'm not sure how you plan on reusing the array. Just keep in mind that this will be stored in memory so you will need to use it in a class or in a global variant array.

Testing that it works is easy. Loop through the array and use the join function on the 2nd D to string the values together:

Private m_varNAMEVALS As Variant

Public Sub Test()
    Dim lngItem As Long
    
    m_varNAMEVALS = NameVals(Sheet1.Range("A1:B20"))
    
    '\\ check the immdiate window for results (ctl+G)
    For lngItem = LBound(m_varNAMEVALS) To UBound(m_varNAMEVALS)
        Debug.Print m_varNAMEVALS(lngItem, 1), Join(m_varNAMEVALS(lngItem, 2))
    Next lngItem
End Sub

Processing the related values appears a little more tricky, but hopefully easy enough for you to follow. This demonstrates how to sum up the associated values.

Public Sub SumVals()
    Dim lngNameItem As Long, lngValItem As Long
    Dim varTemp As Variant
    Dim dblResult As Double
    
    m_varNAMEVALS = NameVals(Sheet1.Range("A1:B20"))
    
    '\\ 1st loop through the primary array
    For lngNameItem = LBound(m_varNAMEVALS) To UBound(m_varNAMEVALS)
        '\\ make sure that the result variable is clear before processing the current name
        dblResult = Empty
        '\\ load the temporary variant array with the nested array (in 2nd D)
        '\\ then loop through the temp array
        varTemp = m_varNAMEVALS(lngNameItem, 2)
        For lngValItem = LBound(varTemp) To UBound(varTemp)
            dblResult = dblResult + varTemp(lngValItem)
        Next lngValItem
        '\\ check the immdiate window for results (ctl+G)
        Debug.Print m_varNAMEVALS(lngNameItem, 1), dblResult
    Next lngNameItem
    
End Sub