NotaVBAeXpert
New Member
- Joined
- May 4, 2018
- Messages
- 26
Hi,
I am trying to insert a new row based on if the cells in "column E" have "B" in them. I would also like to copy the data in the originial row (Columns C and F) to the newly inserted row (columns C and F).
This is what I have so far but it isn't working and I'm not even sure if this is a good start. Any help would be appreciated.
Thanks
___________________________
Option Explicit
Sub Insert_Rows()
Dim rFound As Range, c As Range
Dim myVals
Dim i As Long
myVals = Array("B*")
Application.ScreenUpdating = False
With Range("E1", Range("E" & Rows.Count).End(xlUp))
For i = 0 To UBound(myVals)
.AutoFilter field:=1, Criteria1:=myVals(i)
On Error Resume Next
Set rFound = .Offset(1).Resize(.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
.AutoFilter
If Not rFound Is Nothing Then
For Each c In rFound
Rows(c.Row + 1).Insert
c.Offset(1, -1).Value = c.Value
Next c
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
I am trying to insert a new row based on if the cells in "column E" have "B" in them. I would also like to copy the data in the originial row (Columns C and F) to the newly inserted row (columns C and F).
This is what I have so far but it isn't working and I'm not even sure if this is a good start. Any help would be appreciated.
Thanks
___________________________
Option Explicit
Sub Insert_Rows()
Dim rFound As Range, c As Range
Dim myVals
Dim i As Long
myVals = Array("B*")
Application.ScreenUpdating = False
With Range("E1", Range("E" & Rows.Count).End(xlUp))
For i = 0 To UBound(myVals)
.AutoFilter field:=1, Criteria1:=myVals(i)
On Error Resume Next
Set rFound = .Offset(1).Resize(.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
.AutoFilter
If Not rFound Is Nothing Then
For Each c In rFound
Rows(c.Row + 1).Insert
c.Offset(1, -1).Value = c.Value
Next c
End If
Next i
End With
Application.ScreenUpdating = True
End Sub