Oct 28 2020 05:47 AM - edited Oct 28 2020 05:56 AM
Hi,
I'm new to VBA and macro so I need help with a script/code that can select every 18th-21th row and replace column "I" with the following values:
Paranøtter |
Pekannøtter |
Pistasjnøtter |
Valnøtter |
and replace column "L"-"O" to blank (should be no values).
This should be a loop.
I have attached a part of my dataset and highlighted the rows and columns I want to change.
This is a bit urgent so I'm really trying to automate this process. Thanks for any help you can provide!
Oct 28 2020 07:04 AM
Solution
Sub EditRows()
Dim r As Long
Dim m As Long
Application.ScreenUpdating = False
m = Range("A" & Rows.Count).End(xlUp).Row
For r = 19 To m Step 21
Range("I" & r).Value = "Paranøtter"
Range("I" & r + 1).Value = "Pekannøtter"
Range("I" & r + 2).Value = "Pistasjnøtter"
Range("I" & r + 3).Value = "Valnøtter"
Range("L" & r).Resize(4, 4).ClearContents
Next r
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Oct 29 2020 03:04 AM - edited Oct 29 2020 03:06 AM
Thanks a lot! That saved me so much time!
Just one last thing. Do you know a code for how to move every 5th row to the 21th row? I want to move the row with "Peanøtter" to the last row of each unique product id (see column A). I want all the nuts (nøtter) to be in the same order.
Oct 29 2020 03:43 AM
Sub MovePeanøtter()
Dim r As Long
Dim m As Long
Application.ScreenUpdating = False
m = Range("A" & Rows.Count).End(xlUp).Row
For r = 6 To m Step 21
Range("A" & r).EntireRow.Cut
Range("A" & r + 17).EntireRow.Insert
Next r
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Oct 28 2020 07:04 AM
Solution
Sub EditRows()
Dim r As Long
Dim m As Long
Application.ScreenUpdating = False
m = Range("A" & Rows.Count).End(xlUp).Row
For r = 19 To m Step 21
Range("I" & r).Value = "Paranøtter"
Range("I" & r + 1).Value = "Pekannøtter"
Range("I" & r + 2).Value = "Pistasjnøtter"
Range("I" & r + 3).Value = "Valnøtter"
Range("L" & r).Resize(4, 4).ClearContents
Next r
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub