Insert new rows and slit the amounts

Panoos64 · Nov 23, 2018

Hi all, kindly advice me for a VBA code so that, to run through col. “H” and where find the descriptions “Trade union 1” and “Trade union 2” should insert rows below and also should divide its amounts in col. “J” by 2 and place them in the inserted rows. Descriptions in new rows should be “Trade union 1 employer” and “Trade union 2 employer”. In addition, should update the original amount. Pls see below original data and expected result. Thank you all in advance

Original data
[TABLE="class: MsoNormalTable, width: 476"]
<tbody>[TR]
[TD="width: 42"][/TD]
[TD="width: 113"]

E

[/TD]
[TD="width: 113"]

F

[/TD]
[TD="width: 47"]

G

[/TD]
[TD="width: 267"]

H

[/TD]
[TD="width: 113"]

I

[/TD]
[TD="width: 98"]

J

[/TD]
[/TR]
[TR]
[TD="width: 42"]

20

[/TD]
[TD="width: 113"]

202010810

[/TD]
[TD="width: 113"][/TD]
[TD="width: 47"][/TD]
[TD="width: 267"]

Trade union 1

[/TD]
[TD="width: 113"][/TD]
[TD="width: 98"]

450.55

[/TD]
[/TR]
[TR]
[TD="width: 42"]

22

[/TD]
[TD="width: 113"]

202010818

[/TD]
[TD="width: 113"][/TD]
[TD="width: 47"][/TD]
[TD="width: 267"]

Trade union 2

[/TD]
[TD="width: 113"][/TD]
[TD="width: 98"]

345.36

[/TD]
[/TR]
</tbody>[/TABLE]

Expected result

[TABLE="class: MsoNormalTable, width: 476"]
<tbody>[TR]
[TD="width: 42"][/TD]
[TD="width: 113"]

E

[/TD]
[TD="width: 113"]

F

[/TD]
[TD="width: 47"]

G

[/TD]
[TD="width: 267"]

H

[/TD]
[TD="width: 113"]

I

[/TD]
[TD="width: 98"]

J

[/TD]
[/TR]
[TR]
[TD="width: 42"]

20

[/TD]
[TD="width: 113"]

202010810

[/TD]
[TD="width: 113"][/TD]
[TD="width: 47"][/TD]
[TD="width: 267"]

Trade union 1

[/TD]
[TD="width: 113"][/TD]
[TD="width: 98"]

225.28

[/TD]
[/TR]
[TR]
[TD="width: 42"]

21

[/TD]
[TD="width: 113"]

202010812

[/TD]
[TD="width: 113"][/TD]
[TD="width: 47"][/TD]
[TD="width: 267"]

Trade union 1 employer

[/TD]
[TD="width: 113"][/TD]
[TD="width: 98"]

225.27

[/TD]
[/TR]
[TR]
[TD="width: 42"]

22

[/TD]
[TD="width: 113"]

202010818

[/TD]
[TD="width: 113"][/TD]
[TD="width: 47"][/TD]
[TD="width: 267"]

Trade union 2

[/TD]
[TD="width: 113"][/TD]
[TD="width: 98"]

172.68

[/TD]
[/TR]
[TR]
[TD="width: 42"]

23

[/TD]
[TD="width: 113"]

202010820

[/TD]
[TD="width: 113"][/TD]
[TD="width: 47"][/TD]
[TD="width: 267"]

Trade union 2 employer

[/TD]
[TD="width: 113"][/TD]
[TD="width: 98"]

172.68

[/TD]
[/TR]
</tbody>[/TABLE]

JLGWhiz · Nov 23, 2018

try this

Code:

Sub t()
Dim c As Range
    With ActiveSheet
        For Each c In .Range("H2", .Cells(Rows.Count, "H").End(xlUp))
            If c.Value = "Trade union 1" Or c.Value = "Trade union 2" Then
                c.Offset(1).EntireRow.Insert
                c.Offset(1, 2) = Int(c.Offset(, 2).Value / 2)
                c.Offset(1) = c.Value & vbLf & "employer"
                c.Offset(, 2) = c.Offset(1, 2).Value + c.Offset(, 2).Value Mod 2
            End If
        Next
    End With
End Sub

Panoos64 · Nov 26, 2018

Thank you JLGW, is perfect work and is base on my data. also many thanks for your time spent for my project. Hv a great day!

Panoos64 · Nov 26, 2018

Apologies JLGW, it works, but it round the decimals to zero, kindly can you modify it, so that to prepare the accurate numbers in decimals too? it would much appreciate.

JLGWhiz · Nov 26, 2018

Panoos64 said:
Apologies JLGW, it works, but it round the decimals to zero, kindly can you modify it, so that to prepare the accurate numbers in decimals too? it would much appreciate.

You will need to format the column to return the numbe of decimal places that you want.

Code:

Sub t2()
Dim c As Range
    With ActiveSheet
        For Each c In .Range("H2", .Cells(Rows.Count, "H").End(xlUp))
            If c.Value = "Trade union 1" Or c.Value = "Trade union 2" Then
                c.Offset(1).EntireRow.Insert
                c.Offset(1, 2) = c.Offset(, 2).Value / 2
                c.Offset(1) = c.Value & vbLf & "employer"
                c.Offset(, 2) = c.Offset(, 2).Value / 2
            End If
        Next
    End With
End Sub

Panoos64 · Nov 30, 2018

Thank you once again JLG, Now it works perfect. Hv a great lovely day

JLGWhiz · Nov 30, 2018

Panoos64 said:
Thank you once again JLG, Now it works perfect. Hv a great lovely day

You're welcome,
Regards, JLG

Insert new rows and slit the amounts

Panoos64

Well-known Member

Excel Facts

JLGWhiz

Well-known Member

Panoos64

Well-known Member

Panoos64

Well-known Member

JLGWhiz

Well-known Member

Panoos64

Well-known Member

JLGWhiz

Well-known Member

Similar threads

Forum statistics

Share this page

Insert new rows and slit the amounts

Panoos64

Well-known Member

Excel Facts

JLGWhiz

Well-known Member

Panoos64

Well-known Member

Panoos64

Well-known Member

JLGWhiz

Well-known Member

Panoos64

Well-known Member

JLGWhiz

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock