Trying to make some weird things with VBA finding duplicates (a tricky one)

Question

I got 2 tabs in excel and i am kinda new to VBA:

Operations:

Details:

Take a look at this: DESCRIPTION field from tab "Operations" will contain different "operation codes" (it may contain 1 operation code, 2 operation codes or much more). It is a 11-DIGIT number . The problem is that this field is fixed and sometimes the operation code is truncated.

ONLY THOSE NUMBERS with exact amount of 11 digits must be considered

I WANT TO ACHIEVE THIS (THEY MUST BE EXECUTED IN ORDER):

VBA SHOULD FIND EVERY TRANSACTION INSIDE "DESCRIPTION" CELL FROM TAB "OPERATIONS". IN THIS CASE THE FIRST ROW CONTAINS ONE TRANSACTION, ROW 2 CONTAINS ONE TRANSACTION AND ROW 3 CONTAINS 2 TRANSACTIONS AND ONLY CONSIDER THE OPERATION CODES WITHIN 11 DIGITS
IT SHOULD COPY THE NUMBER FROM TAB "OPERATIONS" AND PASTE IT INSIDE COLUMN "LINKED" FROM TAB "DESCRIPTION"
FIND ALL THE REPEATED VALUES INSIDE "DESCRIPTION" FIELD, GROUP THEM AND PERFORM THIS:

a)

--- IF THE REPEATED VALUES CONTAIN A TYPE "FC" AND "N/C" IT MUST PUT THE VALUE OF THE CELL "NUMBER" FROM TAB "OPERATIONS" OF TYPE "N/C" AND PLACE IT INSIDE "LINKED" COLUMN FROM TAB "DETAILS" AND THEN, WRITE WORD: "DONE" INSIDE "NOTE" FIELD AND FINALLY PASTE THE VALUE OF MONEY COLUMN INSIDE "WEB" COLUMN.

EXPECTED RESULT:

EDIT#1: this would be the desired output:

id|id|id|id|id|id|id|TYPE|NUMBER         |SECTOR|DESCRIPTION                    |MONEY|AMOUNT|TOTAL|WEB|||DIFFERENCE||
1 |1 |1 |1 |1 |1 |1 |FAC |B0001100005429 |XX    |SADADECO 19278294999           |XX   |XX    |XX   |XX |||          ||
1 |1 |1 |1 |1 |1 |1 |N/C |B0001100005445 |XX    |SADADECO 19278294999           |XX   |XX    |XX   |23 |||          || 
2 |2 |2 |2 |2 |2 |2 |FAC |B0001100006545 |XX    |ORDONEZC9920 19299490733       |XX   |XX    |XX   |XX |||          ||
2 |2 |2 |2 |2 |2 |2 |N/C |B0001100005449 |XX    |ORDONEZC9920 19299490733       |XX   |XX    |XX   |33 |||          ||
3 |3 |3 |3 |3 |3 |3 |FAC |B0001100007429 |XX    |rer 19266048445 19266048223    |XX   |XX    |XX   |XX |||          ||
3 |3 |3 |3 |3 |3 |3 |N/C |B0001100007729 |XX    |rer 19266048445 19266048223    |XX   |XX    |XX   |33 |||          ||
4 |4 |4 |4 |4 |4 |4 |FAC |B0001100007829 |XX    |IGN_GONTAN 19266048445 19299494|XX   |XX    |XX   |XX |||          ||
4 |4 |4 |4 |4 |4 |4 |N/C |B0001100009029 |XX    |IGN_GONTAN 19266048445 19299494|XX   |XX    |XX   |434|||          ||
5 |5 |5 |5 |5 |5 |5 |FAC |B0001100009229 |XX    |rer 19266049495                |XX   |XX    |XX   |XX |||          ||
6 |6 |6 |6 |6 |6 |6 |FAC |B0001100009429 |XX    |rer 19266049499                |XX   |XX    |XX   |XX |||          ||
7 |7 |7 |7 |7 |7 |7 |FAC |B0001100009929 |XX    |rer 19266049999                |XX   |XX    |XX   |XX |||          ||
8 |8 |8 |8 |8 |8 |8 |REC |C0001100004929 |XX    |SADADECO 19271194999           |XX   |XX    |XX   |XX |||          ||
8 |8 |8 |8 |8 |8 |8 |REC |D0001100004929 |XX    |SADADECO 19271194999           |XX   |XX    |XX   |XX |||          ||
8 |8 |8 |8 |8 |8 |8 |REV |E0001100004929 |XX    |SADADECO 19271194999           |XX   |XX    |XX   |XX |||          ||
9 |9 |9 |9 |9 |9 |9 |FAC |Z0001100004929 |XX    |FSDKFKS 19551194999            |XX   |XX    |XX   |XX |||          ||
9 |9 |9 |9 |9 |9 |9 |FAC |Z0001109904929 |XX    |FSDKFKS 19551194999            |XX   |XX    |XX   |XX |||          ||
10|10|10|10|10|10|10|REC |W0001109904729 |XX    |AFDKFKR 19711194999            |XX   |XX    |XX   |XX |||          ||
10|10|10|10|10|10|10|REC |W0001108904729 |XX    |AFDKFKR 19711194999            |XX   |XX    |XX   |XX |||          ||



Date      |operation|type|  type|   transaction number |operation  |money|  linked      | note
27/02/2022| null    |null|  null|   null               |19278294999|23   |B0001100005445|DONE
27/02/2022| null    |null|  null|   null               |19299490733|33   |B0001100005449|DONE
27/02/2022| null    |null|  null|   null               |19266048223|33   |B0001100007729|DONE
27/02/2022| null    |null|  null|   null               |19266048445|434  |B0001100009029|DONE
27/02/2022| null    |null|  null|   null               |19266049495|23   |B0001100009229|
27/02/2022| null    |null|  null|   null               |19266049499|223  |B0001100009429|              
27/02/2022| null    |null|  null|   null               |19266049999|424  |B0001100009929|              
27/02/2022| null    |null|  null|   null               |19271194999|74574|E0001100004929|

dataset:

OPERATIONS TABLE

id|id|id|id|id|id|id|TYPE|NUMBER         |SECTOR|DESCRIPTION                    |MONEY|AMOUNT|TOTAL|WEB|||DIFFERENCE||
1 |1 |1 |1 |1 |1 |1 |FAC |B0001100005429 |XX    |SADADECO 19278294999           |XX   |XX    |XX   |XX |||          ||
1 |1 |1 |1 |1 |1 |1 |N/C |B0001100005445 |XX    |SADADECO 19278294999           |XX   |XX    |XX   |XX |||          || 
2 |2 |2 |2 |2 |2 |2 |FAC |B0001100006545 |XX    |ORDONEZC9920 19299490733       |XX   |XX    |XX   |XX |||          ||
2 |2 |2 |2 |2 |2 |2 |N/C |B0001100005449 |XX    |ORDONEZC9920 19299490733       |XX   |XX    |XX   |XX |||          ||
3 |3 |3 |3 |3 |3 |3 |FAC |B0001100007429 |XX    |rer 19266048445 19266048223    |XX   |XX    |XX   |XX |||          ||
3 |3 |3 |3 |3 |3 |3 |N/C |B0001100007729 |XX    |rer 19266048445 19266048223    |XX   |XX    |XX   |XX |||          ||
4 |4 |4 |4 |4 |4 |4 |FAC |B0001100007829 |XX    |IGN_GONTAN 19266048445 19299494|XX   |XX    |XX   |XX |||          ||
4 |4 |4 |4 |4 |4 |4 |N/C |B0001100009029 |XX    |IGN_GONTAN 19266048445 19299494|XX   |XX    |XX   |XX |||          ||
5 |5 |5 |5 |5 |5 |5 |FAC |B0001100009229 |XX    |rer 19266049495                |XX   |XX    |XX   |XX |||          ||
6 |6 |6 |6 |6 |6 |6 |FAC |B0001100009429 |XX    |rer 19266049499                |XX   |XX    |XX   |XX |||          ||
7 |7 |7 |7 |7 |7 |7 |FAC |B0001100009929 |XX    |rer 19266049999                |XX   |XX    |XX   |XX |||          ||
8 |8 |8 |8 |8 |8 |8 |REC |C0001100004929 |XX    |SADADECO 19271194999           |XX   |XX    |XX   |XX |||          ||
8 |8 |8 |8 |8 |8 |8 |REC |D0001100004929 |XX    |SADADECO 19271194999           |XX   |XX    |XX   |XX |||          ||
8 |8 |8 |8 |8 |8 |8 |REV |E0001100004929 |XX    |SADADECO 19271194999           |XX   |XX    |XX   |XX |||          ||
9 |9 |9 |9 |9 |9 |9 |FAC |Z0001100004929 |XX    |FSDKFKS 19551194999            |XX   |XX    |XX   |XX |||          ||
9 |9 |9 |9 |9 |9 |9 |FAC |Z0001109904929 |XX    |FSDKFKS 19551194999            |XX   |XX    |XX   |XX |||          ||
10|10|10|10|10|10|10|REC |W0001109904729 |XX    |AFDKFKR 19711194999            |XX   |XX    |XX   |XX |||          ||
10|10|10|10|10|10|10|REC |W0001108904729 |XX    |AFDKFKR 19711194999            |XX   |XX    |XX   |XX |||          ||

DETAILS table:

Date      |operation|type|  type|   transaction number |operation  |money|  linked| note
27/02/2022| null    |null|  null|   null               |19278294999|23   |        |
27/02/2022| null    |null|  null|   null               |19299490733|33   |        |
27/02/2022| null    |null|  null|   null               |19266048223|33   |        |
27/02/2022| null    |null|  null|   null               |19266048445|434  |        |
27/02/2022| null    |null|  null|   null               |19266049495|23   |        |
27/02/2022| null    |null|  null|   null               |19266049499|223  |        |
27/02/2022| null    |null|  null|   null               |19266049999|424  |        |
27/02/2022| null    |null|  null|   null               |19271194999|74574|        |
27/02/2022| null    |null|  null|   null               |19266048223|343  |        |

Steps 1 and 2 can be solved by using this code:

Sub M_snb()
    
    Dim wsOps As Worksheet, wsDets As Worksheet
    Dim c As Range, col As Collection, v, m
    Dim dataOps, dataDets, rO As Long, rD As Long
    
    Set wsOps = ThisWorkbook.Worksheets("Operations")
    Set wsDets = ThisWorkbook.Worksheets("Details")
    
    dataOps = wsOps.Range("A1").CurrentRegion.Value
    dataDets = wsDets.Range("A1").CurrentRegion.Value
    
    For rO = 2 To UBound(dataOps, 1)
        Set col = AllNumbers(dataOps(rO, 3))
        For Each v In col
            For rD = 2 To UBound(dataDets, 1)
                If CStr(dataDets(rD, 1)) = v Then
                    dataDets(rD, 3) = dataOps(rO, 1)
                    dataOps(rO, 4) = dataOps(rO, 4) + dataDets(rD, 2)
                End If
            Next rD
        Next v
    Next rO
    
    DropArray dataOps, wsOps.Range("A1")
    DropArray dataDets, wsDets.Range("A1")
End Sub

'return all 11-digit strings in v as a Collection
Function AllNumbers(v) As Collection
    Const NUM_DIGITS As Long = 11
    Dim m As Object, mc As Object, col As New Collection, txt, i As Long, patt, ss
    txt = " " & v & " "
    patt = String(NUM_DIGITS, "#")
    i = 2
    For i = 2 To Len(txt) - NUM_DIGITS
        ss = Mid(txt, i, 11)
        If ss Like patt Then
            If Not Mid(txt, i - 1, 1) Like "#" Then
                If Not Mid(txt, i + NUM_DIGITS, 1) Like "#" Then
                    col.Add ss
                End If
            End If
        End If
    Next i
    Set AllNumbers = col
End Function

'Utility method: put a 2d array on a sheet at rng
Sub DropArray(arr, rng As Range)
    rng.Cells(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

EDIT#1: this would be the desi

id|id|id|id|id|id|id|TYPE|NUMBER         |SECTOR|DESCRIPTION                    |MONEY|AMOUNT|TOTAL|WEB|||DIFFERENCE||
1 |1 |1 |1 |1 |1 |1 |FAC |B0001100005429 |XX    |SADADECO 19278294999           |XX   |XX    |XX   |XX |||          ||
1 |1 |1 |1 |1 |1 |1 |N/C |B0001100005445 |XX    |SADADECO 19278294999           |XX   |XX    |XX   |23 |||          || 
2 |2 |2 |2 |2 |2 |2 |FAC |B0001100006545 |XX    |ORDONEZC9920 19299490733       |XX   |XX    |XX   |XX |||          ||
2 |2 |2 |2 |2 |2 |2 |N/C |B0001100005449 |XX    |ORDONEZC9920 19299490733       |XX   |XX    |XX   |33 |||          ||
3 |3 |3 |3 |3 |3 |3 |FAC |B0001100007429 |XX    |rer 19266048445 19266048223    |XX   |XX    |XX   |XX |||          ||
3 |3 |3 |3 |3 |3 |3 |N/C |B0001100007729 |XX    |rer 19266048445 19266048223    |XX   |XX    |XX   |33 |||          ||
4 |4 |4 |4 |4 |4 |4 |FAC |B0001100007829 |XX    |IGN_GONTAN 19266048445 19299494|XX   |XX    |XX   |XX |||          ||
4 |4 |4 |4 |4 |4 |4 |N/C |B0001100009029 |XX    |IGN_GONTAN 19266048445 19299494|XX   |XX    |XX   |434|||          ||
5 |5 |5 |5 |5 |5 |5 |FAC |B0001100009229 |XX    |rer 19266049495                |XX   |XX    |XX   |XX |||          ||
6 |6 |6 |6 |6 |6 |6 |FAC |B0001100009429 |XX    |rer 19266049499                |XX   |XX    |XX   |XX |||          ||
7 |7 |7 |7 |7 |7 |7 |FAC |B0001100009929 |XX    |rer 19266049999                |XX   |XX    |XX   |XX |||          ||
8 |8 |8 |8 |8 |8 |8 |REC |C0001100004929 |XX    |SADADECO 19271194999           |XX   |XX    |XX   |XX |||          ||
8 |8 |8 |8 |8 |8 |8 |REC |D0001100004929 |XX    |SADADECO 19271194999           |XX   |XX    |XX   |XX |||          ||
8 |8 |8 |8 |8 |8 |8 |REV |E0001100004929 |XX    |SADADECO 19271194999           |XX   |XX    |XX   |XX |||          ||
9 |9 |9 |9 |9 |9 |9 |FAC |Z0001100004929 |XX    |FSDKFKS 19551194999            |XX   |XX    |XX   |XX |||          ||
9 |9 |9 |9 |9 |9 |9 |FAC |Z0001109904929 |XX    |FSDKFKS 19551194999            |XX   |XX    |XX   |XX |||          ||
10|10|10|10|10|10|10|REC |W0001109904729 |XX    |AFDKFKR 19711194999            |XX   |XX    |XX   |XX |||          ||
10|10|10|10|10|10|10|REC |W0001108904729 |XX    |AFDKFKR 19711194999            |XX   |XX    |XX   |XX |||          ||



Date      |operation|type|  type|   transaction number |operation  |money|  linked      | note
27/02/2022| null    |null|  null|   null               |19278294999|23   |B0001100005445|DONE
27/02/2022| null    |null|  null|   null               |19299490733|33   |B0001100005449|DONE
27/02/2022| null    |null|  null|   null               |19266048223|33   |B0001100007729|DONE
27/02/2022| null    |null|  null|   null               |19266048445|434  |B0001100009029|DONE
27/02/2022| null    |null|  null|   null               |19266049495|23   |B0001100009229|
27/02/2022| null    |null|  null|   null               |19266049499|223  |B0001100009429|              
27/02/2022| null    |null|  null|   null               |19266049999|424  |B0001100009929|              
27/02/2022| null    |null|  null|   null               |19271194999|74574|E0001100004929|

DO NOTE that field "web" from tab "Operations" contains an Excel formula and when a value is updated by using the VBA it should not delete the formula for the other cells

Tim Williams · Accepted Answer

EDIT: finally fixed and tested (felt bad about leaving it unfinished). This works based on the workbook you shared. No longer using arrays for the data, since you seem to have formulas in there also.

Sub M_snb()
    Const VAL_NC As String = "N/C"
    Const VAL_FAC As String = "FAC"
    
    'column positions - ops
    Const COL_OPS_TYPE As Long = 8
    Const COL_OPS_NUMBER As Long = 9
    Const COL_OPS_DESCR As Long = 11
    Const COL_OPS_MONEY As Long = 12
    
    'column positions - details
    Const COL_DET_OPS_NUM As Long = 5
    Const COL_DET_MONEY As Long = 6
    Const COL_DET_LINKED As Long = 7
    Const COL_DET_NOTE As Long = 8
    
    Dim wsOps As Worksheet, wsDets As Worksheet
    Dim c As Range, col As Collection, v, m
    Dim rngOps As Range, rngDets As Range, rO As Long, rD As Long, rw
    Dim dict As Object, colRows As Collection
    Dim bFAC As Boolean, bNC As Boolean, amt, typ
    
    Set dict = CreateObject("scripting.dictionary")
    
    Set wsOps = ThisWorkbook.Worksheets("Operations")
    Set wsDets = ThisWorkbook.Worksheets("Details")
    
    Set rngOps = wsOps.Range("A1").CurrentRegion
    Set rngDets = wsDets.Range("A1").CurrentRegion
    
    'Loop over ops data and find all unique 11-digit numbers,
    '  and store the rows they're found on in a collection per number
    For rO = 2 To rngOps.Rows.Count
        Set col = AllNumbers(rngOps.Cells(rO, COL_OPS_DESCR).Value)
        For Each v In col
            If Not dict.exists(v) Then dict.Add v, New Collection 'new number?
            dict(v).Add rO 'store current row number
        Next v
    Next rO
            
    For Each v In dict.keys 'loop the unique numbers
        
        Set colRows = dict(v) 'all Operations rows which contain this number...
        bFAC = False
        bNC = False
        For Each rw In colRows 'loop rows and check "types"
            Select Case rngOps.Cells(rw, COL_OPS_TYPE).Value
                Case VAL_NC: bNC = True
                Case VAL_FAC: bFAC = True
            End Select
            If bFAC And bNC Then Exit For 'already found both
        Next rw
            
        'loop over Details and see what rows can be matched to this number
        '  you'll need to figure out the details here...
        For rD = 2 To rngDets.Rows.Count
            If CStr(rngDets.Cells(rD, COL_DET_OPS_NUM).Value) = v Then
                rngDets.Cells(rD, COL_DET_LINKED).Value = rngOps.Cells(colRows(1), COL_OPS_NUMBER).Value
                'dataOps(rO, 4) = dataOps(rO, 4) + dataDets(rD, 2) 'fix this
                If bNC And bFAC Then 'have both types?
                    rngDets.Cells(rD, COL_DET_NOTE).Value = "DONE"
                End If
                'copy the "money" value from Details back to Operations
                amt = rngDets.Cells(rD, COL_DET_MONEY).Value
                For Each rw In colRows
                    If rngOps.Cells(rw, COL_OPS_TYPE).Value = VAL_NC Then
                        rngOps.Cells(rw, COL_OPS_MONEY).Value = amt
                    End If
                Next rw
            End If
        Next rD
    Next v
End Sub


'return all 11-digit strings in v as a Collection
Function AllNumbers(v) As Collection
    Const NUM_DIGITS As Long = 11
    Dim m As Object, mc As Object, col As New Collection, txt, i As Long, patt, ss
    txt = " " & v & " "
    patt = String(NUM_DIGITS, "#")
    i = 2
    For i = 2 To Len(txt) - NUM_DIGITS
        ss = Mid(txt, i, 11)
        If ss Like patt Then
            If Not Mid(txt, i - 1, 1) Like "#" Then
                If Not Mid(txt, i + NUM_DIGITS, 1) Like "#" Then
                    col.Add ss
                End If
            End If
        End If
    Next i
    Set AllNumbers = col
End Function

Trying to make some weird things with VBA finding duplicates (a tricky one)

Answers (1)

Related Questions