Line Up a Code

vicktor

New member
Joined
Oct 10, 2012
Messages
1
Reaction score
0
Points
0
Location
Orlando. Florida
Hi everyone.
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]
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.
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
 
Back
Top