Do Until or For Loop

[GH]

I'm having trouble with the following code. The idea is to find a specific
value and then take an offset cell three below and one left; then CTRL+SHIFT
down to select all non-blank cells and for each cell in that range insert the
found value 5 cells to the left.

I've tried doing it with a do while loop and a for loop. With the do while
loop, it doesn't pick up the non-blank cell and overflows. The for loop
works once, but when I ran it for the next value to be found it goes back to
the first range not the new range. Any suggestions would be helpful.

Sub ModelFormat(Mandate, MgrRange)
Dim oCell As Range
Dim counter As Integer

'Stop
Cells.Select
Selection.Find(What:=Mandate, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
'Stop
'ActiveCell.Select
counter = 0
'Mandate = ActiveCell.Value

Range(ActiveCell.Offset(3, -1), ActiveCell.Offset(3, -1)).Select
'Stop
Range(Selection, Selection.End(xlDown)).Select
'Stop

ActiveWorkbook.Names.Add Name:=MgrRange, RefersToR1C1:= _
"='MVIEW Dump'!R6C1:R43C1"
Stop
'Do While ActiveCell.Value <> "~WORK.CAP"
' Range(ActiveCell.Offset(counter, 5), ActiveCell.Offset(counter,
5)).Value = Mandate
'Range(ActiveCell.Offset(counter, 5), ActiveCell.Offset(counter,
5)).Select
'Range(ActiveCell.Offset(counter, -5), ActiveCell.Offset(counter,
-5)).Select
'Range(Selection, Selection.End(xlDown)).Select
' counter = counter + 1
'Loop

For Each oCell In Range(MgrRange)

Range(oCell.Offset(0, 5), oCell.Offset(0, 5)).Value = Mandate
' Stop
Next oCell

'ActiveWorkbook.Names(MgrRange).Delete

End Sub

 

[Joel]

Does this code help?

Sub ModelFormat(Mandate, MgrRange)

set c = Cells.Find(What:=Mandate, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
if not c is nothing then
MyCol = c.column
LastRow = cells(rows.count,MyCol - 1).end(xlup).row
RowCount = c.row
StartRow = 0
Do while RowCount <= LastRow
If cells(RowCount , Mycol) = Mandate then
RowCount = RowCount + 3
StartRow = RowCount
else
if cells(RowCount, Mycol - 1) <> "" then
cells(StartRow,Mycol - 6) = cells(RowCount, Mycol - 1)
StartRow = StartRow + 1
end if
RowCount = rowCount + 1
end if
loop
end if

End Sub

 

[GH]

Thanks Joel, this pointed me in the right direction. The following code
ended up doing the trick.

Sub ModelFormat(Mandate)
Dim oCell As Range
Dim counter As Integer
Dim c As Range
Dim RowCount As Integer
Dim StartRow As Integer

Cells.Select

Set c = Selection.Find(What:=Mandate, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
c.Select
'Stop
If Not c Is Nothing Then
Mycol = c.Column
Myrow = c.Row
Cells(Myrow + 3, Mycol - 1).Select
LastRow = Selection.End(xlDown).Row
RowCount = Myrow + 3
Do While RowCount <= LastRow
Cells(RowCount, Mycol + 4) = Mandate
RowCount = RowCount + 1
Loop
End If

End Sub

 

[Gary Keramidas]

having a hard time figuring what you're doing, your description didn't seem
to follow your code solution.
anyway, i'm just curious if this does what you want.

Sub ModelFormat(mandate)
Dim oCell As Range
Dim c As Range
Dim myrow
Dim lastrow As Long
With Cells
Set c = .Find(What:=mandate, After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
With Range(Range(c.Address).Offset(3, -1).Address)
lastrow = .End(xlDown).Row
.Resize(lastrow - .Row, 1).Value = mandate
End With
End If
End With
End Sub