Hello and thank you for any attention my post may receive.
My goal is to:
<tbody>
</tbody>
The code I currently have finds the first occurrence, inserts 6 full rows above, then fills those six rows with the data that was above the occurrence. It is rather back to front and I am at lost as to where to make further changes to achieve my goal.
Thanks again in advance, and have a great day!
My goal is to:
- find every occurrence of the word "Weekly" in column C e.g. C3,C6;
- insert 6 lines below (in range A2:C500) each occurrence;
- fill each occurrence of those 6 blank lines with the data from range A2:C500 where the word "Weekly" was found.
A | B | C | |
1 | area | type | frequency |
2 | 264a | a | daily |
3 | 260d | a | weekly |
4 | 264a | c | monthy |
5 | 273c | e | daily |
6 | 264b | c | weekly |
7 | 273a | b | daily |
8 | 264a | d | daily |
<tbody>
</tbody>
The code I currently have finds the first occurrence, inserts 6 full rows above, then fills those six rows with the data that was above the occurrence. It is rather back to front and I am at lost as to where to make further changes to achieve my goal.
Code:
Sub InsertRows()
Cells.Find(What:="Weekly", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Dim d As Integer
d = Range("C:C").End(xlDown).Row
Dim c As Range
For i = d To 1 Step -1
If Cells(i, 3).Value = "Weekly"Then
Dim Rng, n As Long, k As Long
Application.ScreenUpdating = False
Rng = 6
If Rng = "" Then Exit Sub
Range(ActiveCell, ActiveCell.Offset(Val(Rng) - 1, 0)).EntireRow.insert 'Shift:=xlDown
k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 4).End(xlToLeft).Column
Range(Cells(k, 1), Cells(k + Val(Rng), n)).FillDown
End If
Next
End Sub
Thanks again in advance, and have a great day!
Last edited: