D
DavidH56
Hi,
I'm trying to modify this code to look for all blank cells starting with
row3 and fill them in with find results from the data worksheet. This code
works for the first blank cell but stops there. I would like to start with
selecting the first blank cell, looking at the value (text) of the cell blow
it, searching for this value in a long string of text on the data sheet, and
then copying the entire row from the data sheet to the blank cell row. I'm
basically trying to title each group of rows. I would then like to procede
to the next blank cell to do the same until I reach the end of blank cells
with the used range. This is the code I'm starting with.
Sub FindGroupID()
Dim intS As Integer
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet
Application.ScreenUpdating = False
intS = 3
'This step assumes that you have a worksheet named
'Data.
Set wSht = Worksheets("Sheet1")
strToFind = ActiveCell.Offset(1, 0).Value
'Change this range to suit your own needs.
With Worksheets("Data").Range("A1:A100")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
rngC.EntireRow.Copy wSht.Cells(intS, 1)
intS = intS + 1
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With
End Sub
Any help that anyone can provide would be greatly appreciated.
I'm trying to modify this code to look for all blank cells starting with
row3 and fill them in with find results from the data worksheet. This code
works for the first blank cell but stops there. I would like to start with
selecting the first blank cell, looking at the value (text) of the cell blow
it, searching for this value in a long string of text on the data sheet, and
then copying the entire row from the data sheet to the blank cell row. I'm
basically trying to title each group of rows. I would then like to procede
to the next blank cell to do the same until I reach the end of blank cells
with the used range. This is the code I'm starting with.
Sub FindGroupID()
Dim intS As Integer
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet
Application.ScreenUpdating = False
intS = 3
'This step assumes that you have a worksheet named
'Data.
Set wSht = Worksheets("Sheet1")
strToFind = ActiveCell.Offset(1, 0).Value
'Change this range to suit your own needs.
With Worksheets("Data").Range("A1:A100")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
rngC.EntireRow.Copy wSht.Cells(intS, 1)
intS = intS + 1
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With
End Sub
Any help that anyone can provide would be greatly appreciated.