Insert new line each time condition is met in a 2-dim array

Tango_Bravo

New Member
Joined
Jun 14, 2017
Messages
33

<tbody>
</tbody>
I have a few tables in one worksheet. All of them have different names. All start at one row, but at different column. In one of the tables I have a 2dimensional array. Array comprises information about documents (call them 'original'), which have been subsequently amended with another document (call them 'amendment').

here is a sample:
Orig doc
amendment
Date
Column4
Column5
VAL00002540
VAL00002540
7.11.2017
VAL00002540
VAL00002541
7.11.2017
VAL00002564
VAL00002564
27.11.2017


VAL00002564
VAL00002696
27.3.2018


VAL00002564
VAL00002697
27.3.2018


VAL00002566
VAL00002566
30.11.2017
VAL00002566
VAL00002593
21.12.2017
VAL00002566
VAL00002594
21.12.2017

<tbody>
</tbody>

Col 1 represents indentification of the original document. Col 2 represents identification of the current document. Col. 3 represents date of the current document. Whenever vc(c, 1) = vc(c, 2) we are looking at original document. Whenever vc(c, 1) <> vc(c, 2) we are looking at amendment. Col 1 helps me keep track the original document. Cols 2 and 3 provide the details of the amendment.

I would like, upon each amendment to insert new line containing the details of the original document. here is an example of what I want to achieve (added row are marked up in red):

Orig Invoice
Secondary doc
Date
Column4
Column5
VAL00002540
VAL00002540
7.11.2017
VAL00002540
VAL00002541
7.11.2017
VAL00002540
VAL00002540
7.11.2017
VAL00002564
VAL00002564
27.11.2017


VAL00002564
VAL00002696
27.3.2018


VAL00002564
VAL00002564
27.11.2017


VAL00002564
VAL00002697
27.3.2018


VAL00002564
VAL00002564
27.11.2017


VAL00002566
VAL00002566
30.11.2017
VAL00002566
VAL00002593
21.12.2017
VAL00002566
VAL00002566
30.11.2017
VAL00002566
VAL00002594
21.12.2017
VAL00002566
VAL00002566
30.11.2017

<tbody>
</tbody>


this is how far I've reached, and I realise I am doing it totally wrong (it is part of larger code hence).

ReDim vg(1 To UBound(vc, 1), 1 To 10)

For c = 2 To UBound(vc, 1) 'To 2 Step -1
g = g + 1​
If c = 2 Then​
Else​
If vc(c, 1) = vc(c - 1, 1) & vc(c, 2) <> vc(c - 1, 2) Then​
vg(g, 1).EntireRow.Insert​
Else​
vg(g, 1) = vc(c, 1)​
End If​
End if​
Next

Please help!
 

Some videos you may like

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,431
I have a few tables in one worksheet. All of them have different names. All start at one row, but at different column.
If the tables are adjacent to each other and start in the same row (or have common rows) then doing EntireRow.Insert will affect all the tables and adjacent cells. With Excel tables, using the correct table properties, you can add (insert) rows in one table without affecting other tables, or adjacent cells.

Try this code, which assumes your table is named "Table1". For test purposes, the code also puts "New row" in the 4th column to indicate where a row has been inserted.

Code:
Public Sub Add_Row_Each_Amendment()

    Dim amendmentTable As ListObject
    Dim r As Long, i As Long
    Dim newRow As ListRow
    
    Set amendmentTable = ActiveSheet.ListObjects("Table1")
    
    With amendmentTable
        For r = .DataBodyRange.Rows.Count To 1 Step -1
            If .ListRows(r).Range(1).Value <> .ListRows(r).Range(2).Value Then
                'Add new row below
                Set newRow = .ListRows.Add(r + 1)
                'Find original document row in rows above
                i = r
                Do
                    i = i - 1
                Loop While i > 1 And .ListRows(i).Range(1).Value <> .ListRows(i).Range(2).Value
                'Copy original document row to new row
                newRow.Range(1).Value = .ListRows(i).Range(1).Value
                newRow.Range(2).Value = .ListRows(i).Range(1).Value
                newRow.Range(3).Value = .ListRows(i).Range(3).Value
                newRow.Range(4).Value = "New row"
            End If
        Next
    End With
       
End Sub
 

Tango_Bravo

New Member
Joined
Jun 14, 2017
Messages
33
Thank you very much, John_w!

It worked perfect! I made some adjustment to your code to match my scenario.

But now I am stuck with the next and final step in the process.

The table that you helped generate represented range of original documents (invoices), amendments (credit notes) and final documents (final invoices). Thanks to you the original document appears after each amendment and final document.

In my scenario each original document aggregates 1 to x number of records with values (sometimes different sometimes not). Each amendment and each final document comprise one record only each one of them. There is a separate table which keeps track of these records, their values and the document to which the records and values are subscribed. Here is an example:


Col1

Col2
col3 Record
col4 Value
col5
col6
col7
col8Document
col9
col10
col11
col12
Name1
1.5
VAL00002540
Name2
1.0
VAL00002564
Name3
2.3
VAL00002540
Name2
2.1
VAL00002540
Name4
0.5
VAL00002541
Name1
6.3
VAL00002564
Name4
2.1
VAL00002564
Name3
0.1
VAL00002696
Name1
0.5
VAL00002697

<tbody>
</tbody>

I am trying to generate new 2d array combining the array for which you helped (addressed as 've') and the array (addressed as 'vf') containing the records, their values and the document, to which they are subscribed.

Original document appears 2-3 times in 've', so I need to 'call' 2 or 3 times from 'vf' the records and their values, which are subscribed to each original document. Save for some exceptions, records and their values behind original document are "called" 3 times: 1) for original document; 2) after an amendent; and 3) after a final document.

I do not know to how call multiple times records from one and the same array. It seems ReDim Preserve might be useful, but I do not know its syntax, because this is all very new to me and I am not a developer. Here is the code so far, but without my the lamer's attempts on ReDim Preserve. One thing for certain is I am not doing ReDim Preserve:
Code:
ReDim vg(1 To UBound(vf, 1), 1 To 20)

For f = 1 To UBound(vf, 1)
    g = g + 1
    For e = 1 To UBound(ve, 1)
        If vf(f, 8) = ve(e, 2) Then
            vg(g, 1) = ve(e, 1) 'original document
            vg(g, 2) = vf(f, 8) 'current document
            vg(g, 12) = vf(f, 3)    'recorded time
        End If
    Next
Next
 

Watch MrExcel Video

Forum statistics

Threads
1,109,308
Messages
5,527,930
Members
409,793
Latest member
mavrik_stet

This Week's Hot Topics

Top