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
21571

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


21570

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.

21674