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

Question

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

What have you tried so far and where did you run into trouble? Please include these things in your question. — braX

Evil Blue Monkey Evil Blue Monkey · Accepted Answer · 2021-03-01T10:44:51

Try this 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:B5")
    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

You need to properly edit the lines Set RngSolidData = Range("A1:B5") and Set RngCheesyData = RngSolidData.Offset(0, RngSolidData.Columns.Count).Resize(, 4). The first line specifies the "part of the data without holes". It's basically hardcoded. You can create a more dynamic setting or simply specify a different address. Once such part is set, the second line can specify the "part of the data with holes". You can basically keep it as it is but the last number: it must be equal to the number of columns of the "part of the data with holes".

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

1 Answers