CODEWITHSUNDEEP
arraysexcelvba
Dave R
Dave R

Reputation: 21

VBA Matching duplicate results in array and writing them in missing cells

I have a 2 dimensional (x, y) array with names of issuers and their ratings.

MBANK   BBB
0   NR
QUERCUS TFI PL  0
SCHRODER INVMGMT    0
0   NR
NEWAG   0
GRUPA DUON  0
BZ WBK TFI  0
LEGG MASON PL   0
POLAND  0
POLAND  0
POLAND  0
CIECH SA    0
ERBUD SA    0
MBANK   BBB
DB LONDON   BBB+
DB LONDON   0
PIONEER PEKAO   0
MBANK   BBB
TFI PL  0
ELEMENTAL HLDG  0
MONNARI TRADE   0
MIDAS SA    0
PE MGMS SA  0
MOSTOSTAL ZABRZE    0
LC CORP 0
BANK HANDLOWY W NR
POLAND  A
MBANK   0

Unfortunately, the software that generates this list is flawed and does not give all the isuers ratings, sometimes writing a 0.

My goal is to have the issuers (with the exact same name) have the same rating in the entire array. In the example provided, MBANK has a rating BBB but in the last entry MBANK has a 0. My code so far:

'rating
ReDim rating_array(n, 2)
For x = 1 To n
        rating_array(x, 1) = ThisWorkbook.Sheets("SAP BW Data").Cells(1 + x, 21) 'issuer group names
        rating_array(x, 2) = ThisWorkbook.Sheets("SAP BW Data").Cells(1 + x, 34) 'ratings
Next x


For i = 1 To UBound(rating_array)
    If rating_array(i, 1) = 0 Then
        Issuer = rating_array(i, 2) 'issuer group name with blank rating
        'to do: search through the array, find "Issuer", if at least one has a rating, give all "Issuer" the same rating.

My goal: is to search through the array, find that MBANK has a 0 at the bottom, then I want to look through all the entries with MBANK and find the one where there is a rating (in this case it would be the first entry - BBB) and have that rating replace all the MBANK's which currently have 0. The way the data is generated, there shouldn't be any situation, where there would be entries with different ratings under the same name. Also, my list is about 1500 items long, so the function should be relatively smooth as there's a lot of other stuff also going on in code ;).

Not sure how to handle the "search for and replace" part of the code. I would appreciate some tips on this!

Upvotes: 0

Views: 55

Answers (1)

Zac
Zac

Reputation: 1944

Try This 

Dim arrRating As Variant
Dim i, x As Integer

arrRating = Range("A33:B61")

For i = 1 To UBound(arrRating)

    If arrRating(i, 2) = 0 Then

        For x = 1 To UBound(arrRating)

            If arrRating(x, 2) <> 0 And arrRating(x, 1) = arrRating(i, 1) Then

                arrRating(i, 2) = arrRating(x, 2)
                Exit For

            End If

        Next

    End If

Next

Range("A33").Resize(UBound(arrRating, 1), UBound(arrRating, 2)).Value = arrRating

You will have to change the range as I used your values but on a different range but hope it helps

Upvotes: 1

Related Questions