if cell in range is not empty add row with that specific value and copy some other values

jellevansoelen

New Member
Joined
Mar 1, 2021
Messages
22
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi excel macro expert,

I'm searching for a specific complex excel macro.

I have a document with more than 5000 rows. Each row has 10 columns. The first 3 colums (A,B,C) from a row is a default value. But from column D is different. Some cells has a value and some is empty. I'm looking for a macro/script which insert a new row by when the cell is not empty from column D. But with that specific value from cell D-E-F-G-H. And copy the default values of cell A,B,C.

Data is like:

A 12-10-2020 Plan A Plan B Plan C
B 16-10-2020 Plan A
C 25-10-2020 Plan A Plan B
D 27-10-2020 Plan A Plan C
E 29-10-2020 Plan A

End results would be like:
A 12-10-2020 Plan A
A 12-10-2020 Plan B
A 12-10-2020 Plan C
B 16-10-2020 Plan A
C 25-10-2020 Plan A
C 25-10-2020 Plan B
D 27-10-2020 Plan A
D 27-10-2020 Plan C
E 29-10-2020 Plan A

Hopefully you can understand me and someone can help me.

Tnx
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
VBA Code:
Sub jellevansoelen()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   With Sheets("Sheet1")
      Ary = Range("A2:J" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary) * 7, 1 To 3)
   
   For r = 1 To UBound(Ary)
      For c = 3 To 10
         If Ary(r, c) <> "" Then
            nr = nr + 1
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(r, 2)
            Nary(nr, 3) = Ary(r, c)
         End If
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 3).Value = Nary
End Sub
Change sheet names to suit.
 

jellevansoelen

New Member
Joined
Mar 1, 2021
Messages
22
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Tnk you!

This script is working for me :):

VBA Code:
Sub SubNewRows()



'Declarations.

Dim RngSolidData As Range

Dim RngCheesyData As Range

Dim RngTarget As Range

Dim RngResult As Range

Dim DblCounter01 As Double



'Settings.

Set RngSolidData = Range("A1:D3")

Set RngCheesyData = RngSolidData.Offset(0, RngSolidData.Columns.Count).Resize(, 4)



'Creating a new sheet for the output.

Worksheets.Add



'Setting.

Set RngResult = Range("A1")



'Covering each cell in RngCheesyData.

For Each RngTarget In RngCheesyData



'Checking if the given cell is not empty.

If RngTarget.Value <> "" Then



'Reporting the row from RngSolidData.

RngSolidData.Rows(RngTarget.Row - RngCheesyData.Row + 1).Copy RngResult



'Reporting the data in RngTarget.

RngResult.Offset(0, RngSolidData.Columns.Count).Value = RngTarget.Value



'Setting RngResult for the next row.

Set RngResult = RngResult.Offset(1, 0)



End If

Next



End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
Glad you sorted it & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,713
Messages
5,637,926
Members
416,993
Latest member
ant8989

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
Top