ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Help with code (https://www.excelbanter.com/excel-programming/311640-help-code.html)

Dnk

Help with code
 
The code below is intended to match two identical blocks of numbers in
range A1:C120 & F1:H120. I any of the rows do not have a maching
number then the out put in the array holdNum() must be placed on the
worksheet range K1: P(n).

I beleive I have almost accomplished the task except that some of the
sets are identical and this is not what is wanted. Can some one please
modify so that no dupicates are placed in the output area.
Thanks
Sub MixNumbers()
Dim holdNum(1 To 6) As Integer
Dim NumCount As Long
Dim r As Long
Dim T As Long
Dim n As Range
Dim S As Range
Dim d As Integer
Dim v As Variant
Dim x As Variant
Dim y As Range
Dim m As Long
Dim z As Integer
Dim rn As Long
Dim c As Long

rn = 1
c = 0

NumCount = 0
'Clear the target area
Range("Y2:Y5,S2:X2,K1:P65500").ClearContents
Application.StatusBar = ""

For T = 1 To 120
For r = 1 To 120
For Each n In Range(Cells(r, 1), Cells(r, 3))
For Each S In Range(Cells(T, 6), Cells(T, 8))
If S = n Then
c = c + 1
End If
Next S
Next n

If c = 0 Then
For Each v In Union(Range(Cells(T, 6), Cells(T,
8)), Range(Cells(r, 1), Cells(r, 3)))
d = d + 1
holdNum(d) = v
Next v
d = 0
'Temporarily place values in array on worksheet
Range(Cells(2, 17), Cells(2, 22)).Value =
holdNum()
'Check existing combination to see if there are
any matches
For m = 1 To NumCount
For Each y In Range(Cells(m, 11), Cells(m,
16))
For Each x In holdNum()
If y = x Then
z = z + 1
End If
' A exact match is found
If z = 4 Then
z = 0
Exit For
Else
End If
Next x
Next y
Next m
'Place value of array to target area on
worksheet
If z < 4 Then
Range(Cells(rn, 11), Cells(rn,
16)).Value = holdNum()
NumCount = NumCount + 1
Application.StatusBar =
"Combinations Processed: " & Format(NumCount, ("#,##0#"))
rn = rn + 1
End If

End If ' IF C = 0
c = 0
Next r
Next T
'application.StatusBar = ""
End Sub

Thanks for your help.
Derick


All times are GMT +1. The time now is 04:19 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com