.
All depends on how the data is laid out in your spreadsheet. Not enough information so far to provide an answer.
You can add an image of your sheet in your next post. Make sure it shows everything you presently are working with.
You can also post a copy of your workbook (leave out any confidential info) to a CLOUD site like DROPBOX.COM, Google has a cloud site, Amazon has a cloud site, etc.
Having a copy of your workbook would be best. Reduces the asking of questions back and forth.
.
I've never used DropBox but I'm certain it isn't difficult to use. I understand they have an app you download to your computer which makes it easier. Not certain if they provide a free version.
I know that Amazon has a free version - that's what I use. This is the link for signing up : https://www.amazon.com/b?ie=UTF8&node=15547130011
Option Explicit
Sub test1()
Dim i As Long
Dim Last As Long
Dim Rng As Range
Dim Txt As String
On Error Resume Next
Txt = Application.ActiveWindow.RangeSelection.Address
Set Rng = Range("A1:A150") '<<----------------------------Change range of rows here
If Rng Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Last = Rng.Rows.Count
For i = Last To 1 Step -1
If InStr(1, Rng.Cells(i, 1).Value, "Team") > 0 Then
Rows(Rng.Cells(i, 1).Row).Insert shift:=xlDown
End If
Next
Application.ScreenUpdating = True
FindBlankAndFill
End Sub
Sub FindBlankAndFill()
Dim cnter As Integer
Dim lastRow As Long
Dim i As Integer
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
cnter = 0
Application.ScreenUpdating = False
For i = 8 To lastRow + 1
If IsEmpty(Cells(i, 1)) Then
Cells(i, 1).Value = " Text 1" '<<------------------ Edit text comment here for Col A
Cells(i, 4).Value = " Text 2" '<<------------------ Edit text comment here for Col D
cnter = cnter + 1
End If
Next i
Range("A2").Select
Selection.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
.
You can download the workbook here : https://www.amazon.com/clouddrive/share/fY9o0bsmjqai1aRoYDFXEpK3QcFVDBTrt4bmbeMlJcF
Here is the macro :
Code:Option Explicit Sub test1() Dim i As Long Dim Last As Long Dim Rng As Range Dim Txt As String On Error Resume Next Txt = Application.ActiveWindow.RangeSelection.Address Set Rng = Range("A1:A150") '<<----------------------------Change range of rows here If Rng Is Nothing Then Exit Sub Application.ScreenUpdating = False Last = Rng.Rows.Count For i = Last To 1 Step -1 If InStr(1, Rng.Cells(i, 1).Value, "Team") > 0 Then Rows(Rng.Cells(i, 1).Row).Insert shift:=xlDown End If Next Application.ScreenUpdating = True FindBlankAndFill End Sub Sub FindBlankAndFill() Dim cnter As Integer Dim lastRow As Long Dim i As Integer lastRow = Cells(Rows.Count, 1).End(xlUp).Row cnter = 0 Application.ScreenUpdating = False For i = 8 To lastRow + 1 If IsEmpty(Cells(i, 1)) Then Cells(i, 1).Value = " Text 1" '<<------------------ Edit text comment here for Col A Cells(i, 4).Value = " Text 2" '<<------------------ Edit text comment here for Col D cnter = cnter + 1 End If Next i Range("A2").Select Selection.EntireRow.Delete Application.ScreenUpdating = True End Sub
Can you tell me exactly what this code will do.