vicktor
New member
Hi everyone.
I want to insert the following code into another code.
This routing take one row on E2 and substract all the rows in L and I am trying to see the results in S:X.
and the big code in the attach generate the list of numbers in L, I had been trying to lineup and making work as one, I give it up, some help required.
and here it is the code I want to insert the one before.
I want to insert the following code into another code.
Code:
[COLOR=#574123][FONT=Courier New]Sub Subtract_Row()[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] Dima[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] Dimi As Long, j As Long, rws As Long[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] With Range("E2", Range("L" &Rows.Count).End(xlUp)).Resize(, 21)[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] a= .Value[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] rws = UBound(a, 1)[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] For i = 1 To rws[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] For j = 1 To 6[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] a(i, 15 + j) = Abs(a(1, j) - a(i, 8 + j))[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] Next j[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] Next i[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] .Value = a[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New] EndWith[/FONT][/COLOR]
[COLOR=#574123][FONT=Courier New]End Sub[/FONT][/COLOR]
and the big code in the attach generate the list of numbers in L, I had been trying to lineup and making work as one, I give it up, some help required.
and here it is the code I want to insert the one before.
Code:
Option Explicit
Public sumArr As Long, oddNo As Long, evenNo As Long, oddNoReq As Long, LastRow As Long, _
evenNoReq As Long, minSumValue As Long, maxSumValue As Long, lRow As Long, testRow As Long, m As Long, minMaxRn As Long
Sub Combinations()
sortDataFirst
sumArr = 0: oddNoReq = 0: evenNoReq = 0: minSumValue = 0
maxSumValue = 0: lRow = 0: m = 0: minMaxRn = 0
If Range("D6").Value + Range("D7").Value <> 6 Then
Exit Sub
End If
LastRow = lastRwCt
For m = 1 To 6
Next
minMaxRn = 0
For m = LastRow - 5 To LastRow
minMaxRn = minMaxRn + Cells(m, 1).Value
Next
oddNoReq = Range("D7")
evenNoReq = Range("D6")
minSumValue = Range("D9")
maxSumValue = Range("D10")
Dim exceptrange As Range
Set exceptrange = Range("D12:D30")
Dim rRng As Range, p As Integer
Dim vElements, vresult As Variant
lRow = 1: testRow = 1
Set rRng = Range("A1", Range("A1").End(xlDown))
rRng.Select
p = 6
Dim q As Integer
Dim b As Double
b = 1
For q = 0 To p - 1
b = b * (LastRow - q) / (p - q)
Next q
MsgBox "AMOUNT OF ROWS ARE -> " & b, vbInformation
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Columns("K").Resize(, p + 15).Clear
Call CombinationsNP(vElements, p, vresult, lRow, 1, 1, exceptrange)
MsgBox "LEFT " & lRow - 1 & " ROWS = DIRECTIONS ", vbInformation
Exit Sub
End Sub
Sub CombinationsNP(vElements As Variant, p As Integer, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer, XceptValues As Range)
Dim i As Integer, k As Integer
For i = iElement To UBound(vElements)
vresult(iIndex) = vElements(i)
If iIndex = p Then
For k = LBound(vresult) To UBound(vresult)
If vresult(k) Mod 2 <> 0 Then oddNo = oddNo + 1
If vresult(k) Mod 2 = 0 Then evenNo = evenNo + 1
sumArr = sumArr + vresult(k)
Next
If oddNo = oddNoReq And evenNo = evenNoReq And sumArr >= minSumValue And sumArr <= maxSumValue And LoopRow(XceptValues, sumArr) Then
lRow = lRow + 1
Range("L" & lRow).Resize(, p) = vresult
Range("Z" & lRow) = sumArr
Range("AB" & lRow) = Cells(lRow, "Q") - Cells(lRow, "L")
Range("AD" & lRow) = Cells(lRow, "O") - Cells(lRow, "N")
End If
testRow = testRow + 1
End If
If iIndex <> p Then
Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1, XceptValues)
End If
sumArr = 0
evenNo = 0
oddNo = 0
Next i
Exit Sub
End Sub
Public Function lastRwCt() As Long
Dim o As Long
lastRwCt = Range("A1").CurrentRegion.Count
End Function
Sub sortDataFirst()
Range("A1:A30").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Function LoopRow(inputCol As Range, N As Long) As Boolean
Dim c As Range
For Each c In inputCol
If c.Value = N Then
LoopRow = False
Exit Function
End If
Next c
LoopRow = True
End Function