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

A

AcerS

New Member
Joined
Mar 10, 2020
Messages
7
Office Version
  1. 365
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!


BEFOREABCDEFGHI
1Inv#Customer NameProductQtyPriceExtShippingTaxTotal
22455ABC Companysku1325751013.3156.3
32455ABC Companysku2510501013.3156.3
42455ABC Companysku31881013.3156.3
53150CD Companysku1320600060


AFTERABCDEFGHI
1Inv#Customer NameProductQtyPriceExtShippingTaxTotal
22455ABC Companysku1325751013.3156.3
32455ABC Companysku2510501013.3156.3
42455ABC Companysku31881013.3156.3
52455ABC CompanyShipping11010156.3
62455ABC CompanyTax113.313.3156.3
73150CD Companysku1320600060

Thanks!
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
Hi and welcome to MrExcel.

Try this:

Data on Sheet1, results on Sheet2.
The headings on sheet1 and sheet2 must start at row 1.

VBA Code: 
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:I" & 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, 1)
  j = 1
  For i = 2 To UBound(a)
    If bef <> a(i, 1) And (a(i - 1, 7) <> 0 Or a(i - 1, 8) <> 0) Then
      For k = 1 To 2
        b(j, 1) = a(i - 1, 1)
        b(j, 2) = a(i - 1, 2)
        b(j, 3) = IIf(k = 1, a(1, 7), a(1, 8))
        b(j, 4) = a(i - 1, 4)
        b(j, 5) = IIf(k = 1, a(i - 1, 7), a(i - 1, 8))
        b(j, 6) = IIf(k = 1, a(i - 1, 7), a(i - 1, 8))
        b(j, 9) = a(i - 1, 9)
        j = j + 1
      Next
    End If
    For k = 1 To 9
      b(j, k) = a(i, k)
    Next
    bef = a(i, 1)
    j = j + 1
  Next
  Sheets("Sheet2").Rows("2:" & Rows.Count).ClearContents
  Sheets("Sheet2").Range("A2").Resize(j, 9).Value = b
End Sub
 
Upvote 0
DanteAmor said:
Hi and welcome to MrExcel.

Try this:

Data on Sheet1, results on Sheet2.
The headings on sheet1 and sheet2 must start at row 1.

VBA Code: 
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:I" & 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, 1)
  j = 1
  For i = 2 To UBound(a)
    If bef <> a(i, 1) And (a(i - 1, 7) <> 0 Or a(i - 1, 8) <> 0) Then
      For k = 1 To 2
        b(j, 1) = a(i - 1, 1)
        b(j, 2) = a(i - 1, 2)
        b(j, 3) = IIf(k = 1, a(1, 7), a(1, 8))
        b(j, 4) = a(i - 1, 4)
        b(j, 5) = IIf(k = 1, a(i - 1, 7), a(i - 1, 8))
        b(j, 6) = IIf(k = 1, a(i - 1, 7), a(i - 1, 8))
        b(j, 9) = a(i - 1, 9)
        j = j + 1
      Next
    End If
    For k = 1 To 9
      b(j, k) = a(i, k)
    Next
    bef = a(i, 1)
    j = j + 1
  Next
  Sheets("Sheet2").Rows("2:" & Rows.Count).ClearContents
  Sheets("Sheet2").Range("A2").Resize(j, 9).Value = b
End Sub
Click to expand...

Thank you!!! I very much appreciate the time you took for this.

I sort of simplified my data (removed many columns) to make it easier to ask and provide a solution for. Step 1 for me - I want to learn and understand how this works, Step 2 - figure out how to modify your code to to work on the actual data o_O .
 
Upvote 0
DanteAmor said:
Hi and welcome to MrExcel.

Try this:

Data on Sheet1, results on Sheet2.
The headings on sheet1 and sheet2 must start at row 1.

VBA Code: 
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:I" & 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, 1)
  j = 1
  For i = 2 To UBound(a)
    If bef <> a(i, 1) And (a(i - 1, 7) <> 0 Or a(i - 1, 8) <> 0) Then
      For k = 1 To 2
        b(j, 1) = a(i - 1, 1)
        b(j, 2) = a(i - 1, 2)
        b(j, 3) = IIf(k = 1, a(1, 7), a(1, 8))
        b(j, 4) = a(i - 1, 4)
        b(j, 5) = IIf(k = 1, a(i - 1, 7), a(i - 1, 8))
        b(j, 6) = IIf(k = 1, a(i - 1, 7), a(i - 1, 8))
        b(j, 9) = a(i - 1, 9)
        j = j + 1
      Next
    End If
    For k = 1 To 9
      b(j, k) = a(i, k)
    Next
    bef = a(i, 1)
    j = j + 1
  Next
  Sheets("Sheet2").Rows("2:" & Rows.Count).ClearContents
  Sheets("Sheet2").Range("A2").Resize(j, 9).Value = b
End Sub
Click to expand...

Hi Dante,

I've been trying to recreate this but cannot for the life of me. Quick question for you, how would the code change if position of column A (invoice #) and column B (Customer name) were swapped? I changed the below in red font but it's not working properly. It is adding news rows add each change in column C (product).


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

a = Sheets("Test1").Range("A1:AK" & Sheets("Test1").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, 2)
j = 1
For i = 2 To UBound(a)
If bef <> a(i, 2) And (a(i - 1, 7) <> 0 Or a(i - 1, 8) <> 0) Then
For k = 1 To 2
b(j, 1) = a(i - 1, 1)
b(j, 2) = a(i - 1, 2)
b(j, 3) = IIf(k = 1, a(1, 7), a(1, 8))
b(j, 4) = a(i - 1, 4)
b(j, 5) = IIf(k = 1, a(i - 1, 7), a(i - 1, 8))
b(j, 6) = IIf(k = 1, a(i - 1, 7), a(i - 1, 8))
b(j, 9) = a(i - 1, 9)
j = j + 1
Next
End If
For k = 1 To 9
b(j, k) = a(i, k)
Next
bef = a(i, 1)
j = j + 1
Next
Sheets("Test2").Rows("2:" & Rows.Count).ClearContents
Sheets("Test2").Range("A2").Resize(j, 9).Value = b
End Sub



Thanks
 
Upvote 0
You can put how the data is on sheet1 and how you want the result on sheet2.
Use xl2bb tool.
 
Upvote 0
DanteAmor said:
You can put how the data is on sheet1 and how you want the result on sheet2.
Use xl2bb tool.
Click to expand...

Thanks

Book1
ABCDEFGHI
1Customer NameInv#ProductQtyPriceExtShippingTaxTotal
2Cust1999sku1320600060
3Cust522sku132575100143
4Cust522sku251050100143
5Cust522sku3188100143
6Cust3334444sku1320600060
7Cust69879846sku13257558.55138.55
8Cust69879846sku25105058.55138.55
9Cust4663sku1320600060
Sheet1



Book1
ABCDEFGHI
1Customer NameInv#ProductQtyPriceExtShippingTaxTotal
2Cust1999sku1320600060
3Cust522sku132575100143
4Cust522sku251050100143
5Cust522sku3188100143
6Cust522Shipping11010143
7Cust522Tax100143
8Cust3334444sku1320600060
9Cust69879846sku13257558.55138.55
10Cust69879846sku25105058.55138.55
11Cust69879846Shipping155138.55
12Cust69879846Tax18.558.55138.55
13Cust4663sku1320600060
Sheet2
 
Upvote 0
Did you try the macro without making changes?
If you run the macro add the 2 rows.
What is missing?

________________________________________________________
In your second example you put 1 in Qty, if so, change this line

VBA Code: 
b(j, 4) = a(i - 1, 4)
to this
VBA Code: 
b(j, 4) = 1
 
Upvote 0
DanteAmor said:
Did you try the macro without making changes?
If you run the macro add the 2 rows.
What is missing?

________________________________________________________
In your second example you put 1 in Qty, if so, change this line

VBA Code: 
b(j, 4) = a(i - 1, 4)
to this
VBA Code: 
b(j, 4) = 1
Click to expand...

Yes, the macro worked perfectly in the original post example. My second example just moved column A to column B data and I wanted to see how the code would change. I spent a considerable amount of time and could not figure out how to make it work properly. Hoping you could help with that.

Thanks!
 
Upvote 0
It is not necessary to make changes in the macro.
Did you already try it with the new data?
 
Upvote 0
DanteAmor said:
It is not necessary to make changes in the macro.
Did you already try it with the new data?
Click to expand...

Oh sorry, you are correct. I started fresh and it was working.

When I try to adapt this code to the actual worksheet, it is not working properly. I think it will be helpful if I provide the actual below. First table is the actual, second table is what I would like the result to be.

What ends up happening with my code it it adds the shipping and tax rows after each product instead of at the end. Not sure on how to correct it. I have not added the result output table, but can if needed.


Book1
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAK
1Quote Workflow StatusInvoice Request Completed DateInvoice Request ApprovedQuote NumberOpportunity NameAccount NameID#Product: Product NameSys Product CodeDelivery TypeProduct: Product CodeQuantitySales PriceQuote Line Item: SubtotalShipping and HandlingTaxGrand TotalTax JurisdictionBill To NameBill To Address Line 1Bill To Address Line 2Bill To Address Line 3Bill To CityBill To State/ProvinceBill To Zip/Postal CodeBill To CountryShip To NameShip To Address Line 1Ship To Address Line 2Ship To Address Line 3Ship To CityShip To State/ProvinceShip To Zip/Postal CodeShip To CountryContact NameEmailPhone
2Invoice Request Submitted3/9/2020 17:12100002486test1account1122Review QuestionsES_1ATO18175140010501805account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1
3Invoice Request Submitted3/9/2020 17:12100002486test1account1122Print ReviewES_4ATO4310030010501805account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1
4Invoice Request Submitted3/5/2020 17:23100002481test2account2119Study GuideES_2DIR2140400382account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2
5Invoice Request Submitted3/5/2020 17:23100002481test2account2119VoucherES_3DIR311501500382account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2
6Invoice Request Submitted3/5/2020 17:23100002481test2account2119courseES_5DIR511921920382account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2
Sheet1


Book1
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAK
1Quote Workflow StatusInvoice Request Completed DateInvoice Request ApprovedQuote NumberOpportunity NameAccount NameID#Sys: Product NameSys Product CodeDelivery TypeProduct: Product CodeQuantitySales PriceQuote Line Item: SubtotalShipping and HandlingTaxGrand TotalTax JurisdictionBill To NameBill To Address Line 1Bill To Address Line 2Bill To Address Line 3Bill To CityBill To State/ProvinceBill To Zip/Postal CodeBill To CountryShip To NameShip To Address Line 1Ship To Address Line 2Ship To Address Line 3Ship To CityShip To State/ProvinceShip To Zip/Postal CodeShip To CountryContact NameEmailPhone
2Invoice Request Submitted3/9/2020 17:12100002486test1account1122Review QuestionsES_1ATO18175140010501805account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1
3Invoice Request Submitted3/9/2020 17:12100002486test1account1122Print ReviewES_4ATO4310030010501805account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1
4Invoice Request Submitted3/9/2020 17:12100002486test1account1122Shipping and Handling11051051805account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1
5Invoice Request Submitted3/9/2020 17:12100002486test1account1122Tax1001805account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1account1
6Invoice Request Submitted3/5/2020 17:23100002481test2account2119Study GuideES_2DIR2140400382account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2
7Invoice Request Submitted3/5/2020 17:23100002481test2account2119VoucherES_3DIR311501500382account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2
8Invoice Request Submitted3/5/2020 17:23100002481test2account2119courseES_5DIR511921920382account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2account2
Sheet5


VBA Code: 
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, 1)
    j = j + 1
  Next
  Sheets("Sheet2").Rows("2:" & Rows.Count).ClearContents
  Sheets("Sheet2").Range("A2").Resize(j, 37).Value = b
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Loop each sheet then paste data insert cell down to Master sheet
Replies
4
Views
202
Joe4
Joe4
C
  • Question Question
Automate Grouping of data in a report
Replies
0
Views
232
Cantrecallmyusername
C
M
  • Question Question
Macro to change data from vertically to horizontally
Replies
4
Views
152
Mussa
M
N
  • Question Question
Data Transformation using VBA like subtotal
Replies
1
Views
137
Domenic
D
O
  • Question Question
How to utilize an INDEX MATCH function with a wild card to perform an appropriate match
Replies
1
Views
794
Afro_Cookie
A

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top