Excel VBA help – counting duplicates and filling in data based on those duplicates

Solution for Excel VBA help – counting duplicates and filling in data based on those duplicates
is Given Below:

I’m hoping someone can help me with this. I’m working on a personal music project and using excel to organize my information. If this is too much for here, I’m happy to pay someone to write it for me. Send me an email to this username at gmail and let me know what your rate would be.

Here is what I am trying to do:

Sheet 1 has a lot of data in column A.

Each cell in column A needs to be cross referenced as a duplicate against a huge list of data in Sheet 2 Column B.

If no duplicates are found, put an “X” one cell to the right of the original cell (in Sheet1 Column B)

Now if duplicates are found, there may be between one and five of them

If there is a duplicate in column B sheet2, concatenate the contents of columns C and D from that same row in sheet2, and put that resulting string one cell to the right of the original cell (same place the X would go). If there are multiple duplicates, do the same thing, and put the result one more cell to the right in that same row. Repeat for all duplicates.

Really hoping somebody can help with this. Like I said, email me with your rate and I’m happy to pay for this.

Please, try the next code:

Sub processMusicData()
 'It needs adding a reference to 'Microsoft Scripting Runtime'
 Dim sh As Worksheet, sh1 As Worksheet, lastRA As Long, lastRB As Long, dict As New Scripting.Dictionary
 Dim arrA, arrBD, arrDict, i As Long, j As Long, boolFound As Boolean
 Set sh = Worksheets("Sheet1") 'use here your sheet having data column A:A
 Set sh1 = Worksheets("Sheet2") 'use here your sheet having data columns B:D
 lastRA = sh.Range("A" & sh.rows.count).End(xlUp).row    'last row in column A:A Sh
 lastRB = sh1.Range("B" & sh1.rows.count).End(xlUp).row  'last row in column B:B Sh1
 arrA = sh.Range("A2:A" & lastRA).value                  'place the range in an array to make code faster
 arrBD = sh1.Range("B2:D" & lastRB).value
 For i = 1 To UBound(arrA)                               'iterate between arrA elements:
    For j = 1 To UBound(arrBD)                           'iterate between arrBD elemets to match arrA element:
        If arrA(i, 1) = arrBD(j, 1) Then                 'if a match is found:
            If Not dict.Exists(arrA(i, 1)) Then          'if not such a key in the dictionary:
                dict.Add arrA(i, 1), arrBD(j, 2) & arrBD(j, 3) 'create a key and its item by required concatenation
            Else                                          'if not in dictionary:
                dict(arrA(i, 1)) = dict(arrA(i, 1)) & "|" & arrBD(j, 2) & arrBD(j, 3) 'add the new concatenation separated by "|"
            End If
            boolFound = True                              'make the variable True if a match has been found
        End If
    Next j
    If Not boolFound Then dict(arrA(i, 1)) = "X"          'if no match, create the key and its item as "X"
    boolFound = False                                               'reintitialize the boolean variable
 Next i

 For i = 1 To UBound(arrA)                'iterate between arrA elements
    arrDict = Split(dict(arrA(i, 1)), "|")'split the dictionary item of arrA(i,1) key
    sh.Range("B" & i + 1).Resize(1, UBound(arrDict) + 1).value = arrDict 'drop the above array content in the adiacent columns
 Next i
End Sub

If you do not know how to add the necessary reference, please firstly run the next code. It will automatically add the reference:

Sub addScrRunTimeRef()
  'Add a reference to 'Microsoft Scripting Runtime':
  'In case of error ('Programmatic access to Visual Basic Project not trusted'):
  'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
  '         check "Trust access to the VBA project object model"
  Application.VBE.ActiveVBProject.References.AddFromFile "C:WindowsSysWOW64scrrun.dll"
End Sub

Run the first code only after adding the reference.

Free of charge, even if you did not prove some personal interest in solving the problem by your own. I made an exception, breaking somehow the community rules. Please, at least, learn How to ask if will ever post a new question.