Array match Only 1 RedimPreserve

[xman2000]

Hi partners,

please help. Thank you advanced.

i want make a Array with conditions match, differents sources columns, 2 pairs, X,y of coluns/coords (LIneA, LineB)
i want avoid more 1one Redim Preserve and make more simply array, and put Elments of 2th Pair (LIneB) into End of Array (after last element of 1th Pair LineA).

my goal is put the elements of LineB at end of Array after last element of LineA
with only 1one RedimPReserve at final of Looping, avoiding more Redim and more Loopings ForNext

Attached Workbook Excel sample file
ArrayMatchXMan-Forum2.zip

like this code (work partialy, not to end of Array and only 1th pairs

        'For intSegment = 1 To RowsCountLinesABTotal
    For intSegment = 1 To 13
     ''--------------------------------------------------------------
            x1LineA = LineCoordsLineA.Cells(intSegment, 1)
            Y1LineA = LineCoordsLineA.Cells(intSegment, 2)
            X2LineA = LineCoordsLineA.Cells(intSegment + 1, 1)
            Y2LineA = LineCoordsLineA.Cells(intSegment + 1, 2)
      ''--------------------------------------------------------------
            x1LineB = LineCoordsLineB.Cells(intSegment, 1)
            Y1LineB = LineCoordsLineB.Cells(intSegment, 2)
            X2LineB = LineCoordsLineB.Cells(intSegment + 1, 1)
            Y2LineB = LineCoordsLineB.Cells(intSegment + 1, 2)
       ''--------------------------------------------------------------
''-------------------------------------------------------------------------------
''-------------------------------------------------------------------------------
''-------------------------------------------------------------------------------
''-------------------------------------------------------------------------------
MsgBox "ArrayMatch(n)" & ArrayMatch(n)  ''XMAN2000-INCLUIDO
 
                    '''''If intSegment > 0 And intSegment <= MatchCountTotalMacro Then
    
Dim NQuantLineA As Long
    For NQuantLineA = 1 To MatchCountTotalMacro
    If (x1LineA = ArrayMatch(NQuantLineA)) And (Y1LineA = ArrayMatch(NQuantLineA)) Then
    CounterMatchLineA = CounterMatchLineA + 1
    End If
Next
Dim NQuantLineB As Long
    For NQuantLineB = 1 To MatchCountTotalMacro
    If ((x1LineB = ArrayMatch(NQuantLineB)) And Y1LineB = ArrayMatch(NQuantLineB)) Then
    CounterMatchLineB = CounterMatchLineB + 1
    End If
Next


    MsgBox "CounterMatchLineA " & CounterMatchLineA
''-------------------------------------------------------------------------------
''-------------------------------------------------------------------------------
''-------------------------------------------------------------------------------
''-------------------------------------------------------------------------------
    ReDim Preserve ArrayX1(1 To (13 + counterAdd))
    ReDim Preserve ArrayY1(1 To (13 + counterAdd))
    'ReDim Preserve ArrayX1(1 To RowsCountLinesABTotal - 1)
    'ReDim Preserve ArrayY1(1 To RowsCountLinesABTotal - 1)
''-------------------------------------------------------------------------------
    If (x1LineA <> ArrayMatch(1) And Y1LineA <> ArrayMatch(1)) And CounterMatchLineA > 1 Then
                counterAdd = counterAdd + 1
             ArrayX1(counterAdd) = x1LineA
             ArrayY1(counterAdd) = Y1LineA
    
    ElseIf (x1LineA = ArrayMatch(1) And Y1LineA = ArrayMatch(1)) Then
             counterAdd = counterAdd + 1
             ArrayX1(counterAdd) = x1LineA
             ArrayY1(counterAdd) = Y1LineA
' End If
   ElseIf (x1LineB = ArrayMatch(1)) And (Y1LineB = ArrayMatch(1)) Then
              RowAditionalLineB = 13
             counterAdd = counterAdd + 1


            ArrayX1(counterAdd) = x1LineB
            ArrayY1(counterAdd) = Y1LineB


   ElseIf (x1LineB <> ArrayMatch(1) And Y1LineB <> ArrayMatch(1)) Then
                 RowAditionalLineB = 13
              counterAdd = counterAdd + 1
            


            ArrayX1(counterAdd) = x1LineB
            ArrayY1(counterAdd) = Y1LineB
     End If
         ReDim Preserve ArrayX1(1 To (13 + counterAdd))
    ReDim Preserve ArrayY1(1 To (13 + counterAdd))
''-------------------------------------------------------------------------------
   ActiveSheet.Cells(RowInitialAditional + counterAdd, "AF").Value = ArrayX1(counterAdd)
   ActiveSheet.Cells(RowInitialAditional + counterAdd, "AG").Value = ArrayY1(counterAdd)
''-------------------------------------------------------------------------------
       'counterAdd = 0
 Next ''LineCoordinates

my goal is put the elements of LineB at end of Array after last element of LineA
with only 1one RedimPReserve at final of Looping, avoiding more Redim and more Loopings ForNext

ElseIf (x1LineB <> ArrayMatch(1) And Y1LineB <> ArrayMatch(1)) Then
              RowAditionalLineB = 13
              counterAdd = counterAdd + 1
            ArrayX1(counterAdd) = x1LineB
            ArrayY1(counterAdd) = Y1LineB
end if

    ReDim Preserve ArrayX1(1 To (13 + counterAdd))
    ReDim Preserve ArrayY1(1 To (13 + counterAdd))

''-------------------------------------------------------------------------------
   ActiveSheet.Cells(RowInitialAditional + counterAdd, "AF").Value = ArrayX1(counterAdd)
   ActiveSheet.Cells(RowInitialAditional + counterAdd, "AG").Value = ArrayY1(counterAdd)
''-------------------------------------------------------------------------------
       'counterAdd = 0
 Next ''LineCoordinates

tela1.jpg

edit: i am fixed some mistakes in code and sample file workbook and i hade posted new file v2 please download the new file.
the errors is in the :
x1 fixed by x1LineA
y2 fixed by Y1LineA
x2 fixed by X2LineA
y2 fixed by Y2LineA

[xman2000]

edit: i am fixed some mistakes in code and sample file workbook and i hade posted new file v2 please download the new file.
the errors is in the :
x1 fixed by x1LineA
y1 fixed by Y1LineA
x2 fixed by X2LineA
y2 fixed by Y2LineA

and i am put the last RedimPreserve at final of code but this not change the results.

ElseIf (x1LineB <> ArrayMatch(1) And Y1LineB <> ArrayMatch(1)) Then
              RowAditionalLineB = 13
              counterAdd = counterAdd + 1
            ArrayX1(counterAdd) = x1LineB
            ArrayY1(counterAdd) = Y1LineB
end if

    ReDim Preserve ArrayX1(1 To (13 + counterAdd))
    ReDim Preserve ArrayY1(1 To (13 + counterAdd))

''-------------------------------------------------------------------------------
   ActiveSheet.Cells(RowInitialAditional + counterAdd, "AF").Value = ArrayX1(counterAdd)
   ActiveSheet.Cells(RowInitialAditional + counterAdd, "AG").Value = ArrayY1(counterAdd)
''-------------------------------------------------------------------------------
       'counterAdd = 0
 Next ''LineCoordinates

the name of this macro is "Sub PseudoCodeOnly2()" and this is the more simplified version of 2 other macros in worksheet assigned to CommandButtons.

the other macros have more code of more attempts by me.

i have this 2 examples by i am failing (fail).

ReDim Preserve MyArray(LBound(MyArray) To UBound(MyArray) + 1)
MyArray(UBound(MyArray)) = NewValue

Sub Test()


    Dim ratioArray() As Variant


    ReDim ratioArray(1)
    ReDim Preserve ratioArray(UBound(ratioArray) + 1)
    ratioArray(1) = Cells(1, 1)
End Sub

[xman2000]

I need help, i have more examples of code, but not have success. please.

[xman2000]

i am tested many codes but not I could not get avoid of more Loopings and Redim to put values of LineB at end of values of LIneA

sample file at FirstPost
some ideas?

[Paul_Hossler]

There's a lot of code and data that is not pertinent to the issue in the sample XLSM

Can you eliminate all of the code and data that is not needed? Even the code from the Pseudo2 macro

It will make it a lot easier to review

[xman2000]

There's a lot of code and data that is not pertinent to the issue in the sample XLSM

Can you eliminate all of the code and data that is not needed? Even the code from the Pseudo2 macro

It will make it a lot easier to review

yes, i can eliminate to more clean, but this things are tests and with differents codes, this is the reason i keep.
The Screen have more clean the goal.
i will try clean the sample file and re-upload.
thank you very mutch.

[Paul_Hossler]

The only things to keep are data and macro code that show the problem

After (if) the problem is resolved, then you can integrate the solution into the rest of your workbook

[xman2000]

Sample file clean version attached.

my Goal:
i want put values of LineB at end of values of LIneA into end of Array,
but Avoid of more Loopings and Redim (make only 1one Looping and 1one RedimPreserve if it is possible)

only 2 buttons and 2 versions of same code, you can work on you choose.
i put links of others users of others forums of arrays codes.
''=====================================
in my 1first post have original sample file poluted version with codes of MergeRanges and code of examples of arrays i have tested.

thank you.

ArrayMatchXMan-Forum2CLEAN.zip