Tricky situation in VBA Excel (strange scenarios) - excel

Question

I got 2 tabs in excel and i am kinda new to VBA:
"Operations":
"Details":
You can download the workbook and sampledata from here: Workbook
My CODE actually does this:
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, I MEAN THOSE VALUES WITH SAME DESCRIPTION AND TYPE: FAC and N/C AND PERFORM THIS:
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

Answer 1

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