Enter department next to earnings, deductions etc.

Panoos64 · Nov 30, 2018

Hi all, I would like to use a VBA code so that to copy next to each earnings or deductions or contributions, the department which is in col. “C”. Therefore, that the rows are not stably and I present just an extract of data. There are also deductions & contributions. Below the original data and expected result. Thank you all in advance

Original data

	[FONT=&quot]A[/FONT]	[FONT=&quot]B[/FONT]	[FONT=&quot]C[/FONT]
[FONT=&quot]1[/FONT]	[FONT=&quot]Department[/FONT]		[FONT=&quot]FRONT OFFICE[/FONT]
[FONT=&quot]2[/FONT]	[FONT=&quot]Earnings[/FONT]	[FONT=&quot] [/FONT]	[FONT=&quot] [/FONT]
[FONT=&quot]3[/FONT]	[FONT=&quot]Basic Salary [/FONT]
[FONT=&quot]4[/FONT]	[FONT=&quot]COLA [/FONT]
[FONT=&quot]5[/FONT]	[FONT=&quot]TRAVELING allowances[/FONT]
[FONT=&quot]6[/FONT]	[FONT=&quot]Bonus[/FONT]
[FONT=&quot]7[/FONT]	[FONT=&quot]other earnings[/FONT]
[FONT=&quot]8[/FONT]	[FONT=&quot]Total Earnings[/FONT]	[FONT=&quot] [/FONT]	[FONT=&quot] [/FONT]
[FONT=&quot]9[/FONT]	[FONT=&quot]Department[/FONT]		[FONT=&quot]ACCOUNTS DPT[/FONT]
[FONT=&quot]10[/FONT]	[FONT=&quot]Earnings[/FONT]
[FONT=&quot]11[/FONT]	[FONT=&quot]Basic Salary [/FONT]
[FONT=&quot]12[/FONT]	[FONT=&quot]COLA [/FONT]	[FONT=&quot] [/FONT]	[FONT=&quot] [/FONT]
[FONT=&quot]13[/FONT]	[FONT=&quot]TRAVELING allowances[/FONT]
[FONT=&quot]14[/FONT]	[FONT=&quot]Bonus[/FONT]
[FONT=&quot]15[/FONT]	[FONT=&quot]other earnings[/FONT]
[FONT=&quot]16[/FONT]	[FONT=&quot]Total Earnings[/FONT]

Expected result

	[FONT=&quot]A[/FONT]	[FONT=&quot]B[/FONT]	[FONT=&quot]C[/FONT]
[FONT=&quot]1[/FONT]	[FONT=&quot]Department[/FONT]		[FONT=&quot]FRONT OFFICE[/FONT]
[FONT=&quot]2[/FONT]	[FONT=&quot]Earnings FRONT OFFICE[/FONT]		[FONT=&quot] [/FONT]
[FONT=&quot]3[/FONT]	[FONT=&quot]Basic Salary FRONT OFFICE[/FONT]
[FONT=&quot]4[/FONT]	[FONT=&quot]COLA FRONT OFFICE[/FONT]
[FONT=&quot]5[/FONT]	[FONT=&quot]TRAVELING allowances FRONT OFFICE[/FONT]
[FONT=&quot]6[/FONT]	[FONT=&quot]Bonus FRONT OFFICE[/FONT]
[FONT=&quot]7[/FONT]	[FONT=&quot]other earnings FRONT OFFICE[/FONT]
[FONT=&quot]8[/FONT]	[FONT=&quot]Total Earnings FRONT OFFICE[/FONT]		[FONT=&quot] [/FONT]
[FONT=&quot]9[/FONT]	[FONT=&quot]Department[/FONT]		[FONT=&quot]ACCOUNTS DPT[/FONT]
[FONT=&quot]10[/FONT]	[FONT=&quot]Earnings ACCOUNTS DPT[/FONT]
[FONT=&quot]11[/FONT]	[FONT=&quot]Basic Salary ACCOUNTS DPT[/FONT]
[FONT=&quot]12[/FONT]	[FONT=&quot]COLA ACCOUNTS DPT[/FONT]	[FONT=&quot] [/FONT]	[FONT=&quot] [/FONT]
[FONT=&quot]13[/FONT]	[FONT=&quot]TRAVELING allowances ACCOUNTS DPT[/FONT]
[FONT=&quot]14[/FONT]	[FONT=&quot]Bonus ACCOUNTS DPT[/FONT]
[FONT=&quot]15[/FONT]	[FONT=&quot]other earnings ACCOUNTS DPT[/FONT]
[FONT=&quot]16[/FONT]	[FONT=&quot]Total Earnings ACCOUNTS DPT[/FONT]

Fluff · Nov 30, 2018

Re: Enter department next to earnings, deductions e.t.c

How about

Code:

Sub AddDept()
   Dim Rng As Range
   
   For Each Rng In Range("C1", Range("A" & Rows.Count).End(xlUp).Offset(, 2)).SpecialCells(xlBlanks).Areas
      Rng.Offset(, -2).Resize(1, 1).Value = Rng.Offset(, -2).Resize(1, 1).Value & " " & Rng.Offset(-1).Resize(1, 1)
      Rng.Offset(Rng.Count - 1, -2).Resize(1, 1).Value = Rng.Offset(Rng.Count - 1, -2).Resize(1, 1).Value & " " & Rng.Offset(-1).Resize(1, 1)
   Next Rng
End Sub

Panoos64 · Nov 30, 2018

Re: Enter department next to earnings, deductions e.t.c

Hi Fluff, it works somehow, but it place the department only in bold rows / letters. Is it possible to modify it so that to place department to all rows? It would be highly appreciated. Thank you once again for your support!

Fluff · Nov 30, 2018

Re: Enter department next to earnings, deductions e.t.c

Oops, missed that
Try

Code:

Sub AddDept()
   Dim Rng As Range, Cl As Range
   
   For Each Rng In Range("C1", Range("A" & Rows.Count).End(xlUp).Offset(, 2)).SpecialCells(xlBlanks).Areas
      For Each Cl In Rng
         Cl.Offset(, -2).Value = Cl.Offset(, -2).Value & " " & Rng.Offset(-1).Resize(1, 1)
      Next Cl
   Next Rng
End Sub

Panoos64 · Dec 3, 2018

Re: Enter department next to earnings, deductions e.t.c

Perfect work Fluff, i owe to you a great thanks for your lot of time spent for all my projects and your kind support. Hv a great, lovely day and all the best to you!

Fluff · Dec 3, 2018

Re: Enter department next to earnings, deductions e.t.c

You're welcome & thanks for the feedback

Enter department next to earnings, deductions etc.

Panoos64

Well-known Member

Excel Facts

Fluff

MrExcel MVP, Moderator

Panoos64

Well-known Member

Fluff

MrExcel MVP, Moderator

Panoos64

Well-known Member

Fluff

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Enter department next to earnings, deductions etc.

Panoos64

Well-known Member

Excel Facts

Fluff

MrExcel MVP, Moderator

Panoos64

Well-known Member

Fluff

MrExcel MVP, Moderator

Panoos64

Well-known Member

Fluff

MrExcel MVP, Moderator

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