Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
GH GH is offline
external usenet poster
 
Posts: 11
Default Do Until or For Loop


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


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Do Until or For Loop


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" wrote:

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


  #3   Report Post  
Posted to microsoft.public.excel.programming
GH GH is offline
external usenet poster
 
Posts: 11
Default Do Until or For Loop

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


"Joel" wrote:

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" wrote:

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


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,494
Default Do Until or For Loop

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

--

Gary Keramidas
Excel 2003


"GH" wrote in message
...
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


"Joel" wrote:

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" wrote:

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



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
returning back to loop check condition without completing the loop ashish128 Excel Programming 13 April 3rd 08 12:53 PM
Loop to Filter, Name Sheets. If Blank, Exit Loop ryguy7272 Excel Programming 3 February 5th 08 03:41 PM
(Complex) Loop within loop to create worksheets klysell Excel Programming 1 March 20th 07 12:03 AM
Advancing outer Loop Based on criteria of inner loop ExcelMonkey Excel Programming 1 August 15th 05 05:23 PM
Problem adding charts using Do-Loop Until loop Chris Bromley[_2_] Excel Programming 2 May 23rd 05 01:31 PM


All times are GMT +1. The time now is 06:41 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"