Tricky situation in VBA Excel (strange scenarios)-CodePudding

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

"Operations":

"Details":

You can download the workbook and sampledata from here:

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 COPY THE VALUE OF CELL "MONEY" FROM TAB "DETAILS" AND PASTE IT INSIDE CELL "MONEY" FROM TAB "OPERATIONS"

After running my code i got this:

The thing is that after pasting the value inside column MONEY from tab OPERATIONS i want to copy the NUMBER of the N/C and paste it inside column LINKED from tab DETAILS for that specific operation number.

Take a look, this is the expected result:

VBA code (a macro) in excel:

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

CodePudding user response：

I was able to solve this by myself:

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
    Const COL_OPS_WEB As Long = 15
    
    '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_WEB).Value = amt
                        amt2 = rngOps.Cells(rw, COL_OPS_NUMBER).Value
                        'rngOps.Cells(rw, COL_OPS_WEB).Value = amt2
                        rngDets.Cells(rD, COL_DET_LINKED).Value = amt2
                    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