Nsryjdtyk

Currently I'm creating a check for a column.

Goal: I have a column called currency which I need to check if they are all the same for each Bank (Column A). If there are other currency then it will prompt me.

Additional goal: I would also like to include in the checking the one in column E (Currency (Bank Charge)) to make sure that all currencies for that bank are the same.

Problem: I already have a working code using scripting.dictionary, however, I have some trouble clearing the dictionary for the first loop / currencies for the first Bank. I tried to clear the dictionary before it proceeds to another bank. But it is not working.

Below is the screenshot of what I would like to check:

Below is the current code that I have:

Sub CurrencyTestCheck()



Dim wksSource As Worksheet: Set wksSource = ThisWorkbook.Sheets("Test1")



Dim i As Long

Dim x As Long

Dim lastRow As Long

Dim strBankName As String



Set d = CreateObject("Scripting.dictionary")



Application.ScreenUpdating = False



lastRow = wksSource.Cells(wksSource.Rows.Count, "C").End(xlUp).Row 



For i = 2 To lastRow



If Len(wksSource.Cells(i, 1).Value) > 0 Then 'If a new bank starts



        If Len(strBankName) > 0 Then



                For Each k In d.Keys



                    strCheck = k

                    countCurrency = d(k)



                    msg = msg & strCheck & " - " & countCurrency & vbNewLine

                    x = x + 1



                Next k



                If x > 1 Then



                    MsgBox "There are different currencies for bank " & strBankName & vbNewLine & _

                    vbNewLine & msg, vbCritical, "Warning"



                Else



                    MsgBox "Currencies are all the same for " & strBankName, vbInformation, "Same currencies"



                End If



                d.RemoveAll



        End If





strBankName = wksSource.Cells(i, 1).Value



End If



    'Currency for each Bank



    tmp = Trim(wksSource.Cells(i, 3).Value)

    If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1



Next i



If Len(strBankName) > 0 Then



    For Each k In d.Keys



        strCheck = k

        countCurrency = d(k)



        msg = msg & strCheck & " - " & countCurrency & vbNewLine

        x = x + 1



    Next k



    If x > 1 Then



        MsgBox "There are different currencies for bank " & strBankName & vbNewLine & _

        vbNewLine & msg, vbCritical, "Warning"



    Else



        MsgBox "Currencies are all the same for " & strBankName, vbInformation, "Same currencies"



    End If



End If



Application.ScreenUpdating = True



End Sub

Output:

Previous values are still in the dictionary (USD - 3 and AUD - 2)

Appreciate if you also have another suggestion to do the checking.

You might have forgotten to reset your currency discrepancy counter x.

Set it to x = 0 after the first bank's loop.

i.e.

...

...



    'Currency for each Bank



    tmp = Trim(wksSource.Cells(i, 3).Value)

    If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1



Next i



' Add these two lines:

x = 0

msg = ""



If Len(strBankName) > 0 Then



    For Each k In d.Keys



        strCheck = k



...

...

And like TinMan said, also reset the msg so the previous bank's results don't leak into your the next bank.