Find value in range, Change value, Copy columns of that row. Paste them in first empt row.

[mcorbet]

After using this forum for a long time. Searching other posts and solving my "issue's" I maneged to build an Great excel sheet that helps me with making a import sheet for our planning software. People have there own "request" tool.

I now want to add another feature in the tool but I cant seem to figure out how to make it in VBA. Please help me with this one.

In the Sheet I use there is range B7:M507

With the import function there is the Range is fill with an Dynamic number of rows between 3 and 500.
all columns B:M are filled per row (so now gaps or empty cells are in it)
Column J is fill with 1 till 8, 2D 3D 4D, 1W, 2W, 4W

What im looking for is the folowing.

Check in the range (or Column J) for the value 2D 3D 4D 1W 2W 4W

Change it in 8, Then copy column B till M of that row
Go to the first empty row and Past the copied row.

If the value was 2D, Past it once
if the value was 3D, Past it twice
4d, 3 times
1w, 5 time
2w, 10 time
etc

then search again until there are more rows with 2D, 3D, 4D, 2W, 3W, 4W

Thanks in advance. For now I have placed a screenshot of the Sheet. to clear things out. All text are in Dutch but that should not matter.

 

[mcorbet]

Cant find how to edit my post. But Think this screenshot is better

 

[Fluff]

When you say

Change it in 8, Then copy column B till M of that row

Do you mean change the 2D, 3D etc to 8?

 

[mcorbet]

Yes, The 8 stand for 8 hours and 2D for 2 days what will result in to orders of 8 hours. after importing it in our planning tool

 

[mcorbet]

two :D

 

[Fluff]

Give this a go

Sub CopyRwsXtimes()

    Dim Cl As Range
    
    For Each Cl In Range("J7", Range("J" & Rows.Count).End(xlUp))
        Select Case Cl.Value
            Case "2D"
                Cl.Value = 8
                Cl.Offset(, -8).Resize(, 12).Copy Range("J" & Rows.Count).End(xlUp).Offset(1, -8)
            Case "3D"
                Cl.Value = 8
                Cl.Offset(, -8).Resize(, 12).Copy Range("J" & Rows.Count).End(xlUp).Offset(1, -8).Resize(1 * 2)
            Case "4D"
                Cl.Value = 8
                Cl.Offset(, -8).Resize(, 12).Copy Range("J" & Rows.Count).End(xlUp).Offset(1, -8).Resize(1 * 3)
            Case "1W"
                Cl.Value = 8
                Cl.Offset(, -8).Resize(, 12).Copy Range("J" & Rows.Count).End(xlUp).Offset(1, -8).Resize(1 * 5)
            Case "2W"
                Cl.Value = 8
                Cl.Offset(, -8).Resize(, 12).Copy Range("J" & Rows.Count).End(xlUp).Offset(1, -8).Resize(1 * 10)
        End Select
    Next Cl
End Sub

 

[mcorbet]

Thanks Alot.

Works amazing.

 

[Fluff]

Glad to help & thanks for the feedback