VBA - insert rows based on change in cell and populate rows with data

[AcerS]

Hi all!

Wondering if someone can advise on if it's possible to get something like this done.

I have a file with invoice line item data that comes out of a system, and I would like to import it into another system. The problem is, the export that comes out of the first system does not break out the shipping or tax on separate lines, instead it displays the total on each line. The system I want to import into, requires each line to be separate.

I want to be able to insert 2 rows when either shipping or tax column have values. From there, I'd like to copy some of the data from above lines and enter the shipping and tax on its own lines. Any help is much appreciated!

BEFORE	A	B	C	D	E	F	G	H	I
1	Inv#	Customer Name	Product	Qty	Price	Ext	Shipping	Tax	Total
2	2455	ABC Company	sku1	3	25	75	10	13.3	156.3
3	2455	ABC Company	sku2	5	10	50	10	13.3	156.3
4	2455	ABC Company	sku3	1	8	8	10	13.3	156.3
5	3150	CD Company	sku1	3	20	60	0	0	60

AFTER	A	B	C	D	E	F	G	H	I
1	Inv#	Customer Name	Product	Qty	Price	Ext	Shipping	Tax	Total
2	2455	ABC Company	sku1	3	25	75	10	13.3	156.3
3	2455	ABC Company	sku2	5	10	50	10	13.3	156.3
4	2455	ABC Company	sku3	1	8	8	10	13.3	156.3
5	2455	ABC Company	Shipping	1	10	10			156.3
6	2455	ABC Company	Tax	1	13.3	13.3			156.3
7	3150	CD Company	sku1	3	20	60	0	0	60

Thanks!

 

[DanteAmor]

Not tested.
You did not update this data after "Next"
bef = a(i, 1)

Sub InsertRows()
  Dim a As Variant, b As Variant, bef As Variant
  Dim i As Long, j As Long, k As Long

  a = Sheets("Sheet1").Range("A1:AK" & Sheets("Sheet1").Range("A" & Rows.Count).End(3).Row + 1).Value2
  ReDim b(1 To UBound(a, 1) * 3, 1 To UBound(a, 2))
  bef = a(2, 4)
  j = 1
  For i = 2 To UBound(a)
    If bef <> a(i, 4) And (a(i - 1, 15) <> 0 Or a(i - 1, 16) <> 0) Then
      For k = 1 To 2
        b(j, 1) = a(i - 1, 1)
        b(j, 2) = a(i - 1, 2)
        b(j, 3) = a(i - 1, 3)
        b(j, 4) = a(i - 1, 4)
        b(j, 5) = a(i - 1, 5)
        b(j, 6) = a(i - 1, 6)
        b(j, 7) = a(i - 1, 7)
        b(j, 8) = IIf(k = 1, a(1, 15), a(1, 16))
        b(j, 12) = a(i - 1, 12)
        b(j, 13) = IIf(k = 1, a(i - 1, 15), a(i - 1, 16))
        b(j, 14) = IIf(k = 1, a(i - 1, 15), a(i - 1, 16))
        b(j, 17) = a(i - 1, 17)
        b(j, 19) = a(i - 1, 19)
        b(j, 20) = a(i - 1, 20)
        b(j, 21) = a(i - 1, 21)
        b(j, 22) = a(i - 1, 22)
        b(j, 23) = a(i - 1, 23)
        b(j, 24) = a(i - 1, 24)
        b(j, 25) = a(i - 1, 25)
        b(j, 26) = a(i - 1, 26)
        b(j, 27) = a(i - 1, 27)
        b(j, 28) = a(i - 1, 28)
        b(j, 29) = a(i - 1, 29)
        b(j, 30) = a(i - 1, 30)
        b(j, 31) = a(i - 1, 31)
        b(j, 32) = a(i - 1, 32)
        b(j, 33) = a(i - 1, 33)
        b(j, 34) = a(i - 1, 34)
        b(j, 35) = a(i - 1, 35)
        b(j, 36) = a(i - 1, 36)
        b(j, 37) = a(i - 1, 37)
        j = j + 1
      Next
    End If
    For k = 1 To 37
      b(j, k) = a(i, k)
    Next
    bef = a(i, 4)
    j = j + 1
  Next
  Sheets("Sheet2").Rows("2:" & Rows.Count).ClearContents
  Sheets("Sheet2").Range("A2").Resize(j, 37).Value = b
End Sub

 

[AcerS]

Not tested.
You did not update this data after "Next"
bef = a(i, 1)

Sub InsertRows()
  Dim a As Variant, b As Variant, bef As Variant
  Dim i As Long, j As Long, k As Long

  a = Sheets("Sheet1").Range("A1:AK" & Sheets("Sheet1").Range("A" & Rows.Count).End(3).Row + 1).Value2
  ReDim b(1 To UBound(a, 1) * 3, 1 To UBound(a, 2))
  bef = a(2, 4)
  j = 1
  For i = 2 To UBound(a)
    If bef <> a(i, 4) And (a(i - 1, 15) <> 0 Or a(i - 1, 16) <> 0) Then
      For k = 1 To 2
        b(j, 1) = a(i - 1, 1)
        b(j, 2) = a(i - 1, 2)
        b(j, 3) = a(i - 1, 3)
        b(j, 4) = a(i - 1, 4)
        b(j, 5) = a(i - 1, 5)
        b(j, 6) = a(i - 1, 6)
        b(j, 7) = a(i - 1, 7)
        b(j, 8) = IIf(k = 1, a(1, 15), a(1, 16))
        b(j, 12) = a(i - 1, 12)
        b(j, 13) = IIf(k = 1, a(i - 1, 15), a(i - 1, 16))
        b(j, 14) = IIf(k = 1, a(i - 1, 15), a(i - 1, 16))
        b(j, 17) = a(i - 1, 17)
        b(j, 19) = a(i - 1, 19)
        b(j, 20) = a(i - 1, 20)
        b(j, 21) = a(i - 1, 21)
        b(j, 22) = a(i - 1, 22)
        b(j, 23) = a(i - 1, 23)
        b(j, 24) = a(i - 1, 24)
        b(j, 25) = a(i - 1, 25)
        b(j, 26) = a(i - 1, 26)
        b(j, 27) = a(i - 1, 27)
        b(j, 28) = a(i - 1, 28)
        b(j, 29) = a(i - 1, 29)
        b(j, 30) = a(i - 1, 30)
        b(j, 31) = a(i - 1, 31)
        b(j, 32) = a(i - 1, 32)
        b(j, 33) = a(i - 1, 33)
        b(j, 34) = a(i - 1, 34)
        b(j, 35) = a(i - 1, 35)
        b(j, 36) = a(i - 1, 36)
        b(j, 37) = a(i - 1, 37)
        j = j + 1
      Next
    End If
    For k = 1 To 37
      b(j, k) = a(i, k)
    Next
    bef = a(i, 4)
    j = j + 1
  Next
  Sheets("Sheet2").Rows("2:" & Rows.Count).ClearContents
  Sheets("Sheet2").Range("A2").Resize(j, 37).Value = b
End Sub

Ahhhhhhh, prefect thank you so much for your help!!!!

 

[DanteAmor]

Again with pleasure. Thanks for the feedback