ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Skipping cells in a Do Until loop (https://www.excelbanter.com/excel-programming/332796-skipping-cells-do-until-loop.html)

medicenpringles[_8_]

Skipping cells in a Do Until loop
 

Here is my Code:


Code:
--------------------
Sub CreateMirrorSchedule()

Dim wsCopy As Worksheet
Dim wsPaste As Worksheet
Dim rgCopy As Range
Dim rgPaste As Range

Application.ScreenUpdating = False

Set wsCopy = ThisWorkbook.Worksheets("Weekly Schedule")
Set wsPaste = ThisWorkbook.Worksheets("Schedule Mirror")
Set rgCopy = wsCopy.Range("C9")
Set rgPaste = wsPaste.Range("C9")

wsCopy.Select

Do Until rgCopy = wsCopy.Range("C69")
wsCopy.Select
If IsEmpty(rgCopy) Then
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
Else
rgCopy.Select
rgCopy.Copy
wsPaste.Select
rgPaste.PasteSpecial xlPasteValues
Select Case rgPaste.Value
Case Is < 1
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
Case 1
rgPaste.FormulaR1C1 = "1:00"
Case 1.25
rgPaste.FormulaR1C1 = "1:15"
Case 1.5
rgPaste.FormulaR1C1 = "1:30"
Case 1.75
rgPaste.FormulaR1C1 = "1:45"
Case 2
rgPaste.FormulaR1C1 = "2:00"
Case Else
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
End Select
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
End If
Loop

Set rgCopy = wsCopy.Range("E9")
Set rgPaste = wsPaste.Range("E9")

Do Until rgCopy = wsCopy.Range("E69")
wsCopy.Select
If IsEmpty(rgCopy) Then
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
Else
rgCopy.Select
rgCopy.Copy
wsPaste.Select
rgPaste.PasteSpecial xlPasteValues
Select Case rgPaste.Value
Case Is < 1
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
Case 1
rgPaste.FormulaR1C1 = "1:00"
Case 1.25
rgPaste.FormulaR1C1 = "1:15"
Case 1.5
rgPaste.FormulaR1C1 = "1:30"
Case 1.75
rgPaste.FormulaR1C1 = "1:45"
Case 2
rgPaste.FormulaR1C1 = "2:00"
Case Else
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
End Select
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
End If
Loop

'####### The above pattern is repeated 14 times ########

Set wsCopy = Nothing
Set wsPaste = Nothing
Set rgCopy = Nothing
Set rgPaste = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

--------------------

1) Is there any way to keep a "Do Until" loop from stoping when it sees
an empty cell? i would like to have my loop actually loop until it gets
to cell "C69".

2) Is there a way to rotate throught these columns without having to
reset the variables (as in lines 50-51:
Code:
--------------------
Set rgCopy = wsCopy.Range("E9")
Set rgPaste = wsPaste.Range("E9")
--------------------
) and repeat? I could offset the variables, but the problem is that
some columns have more data than others, so the offset would have to be
different for every time the user inputs data. But, if you can answer
my first question, this explination won't be neccessary.

any help? i'll provide more info if needed.

thanks,
stephen


--
medicenpringles


------------------------------------------------------------------------
medicenpringles's Profile: http://www.excelforum.com/member.php...o&userid=16458
View this thread: http://www.excelforum.com/showthread...hreadid=382056


medicenpringles[_9_]

Skipping cells in a Do Until loop
 

bump

no replies..

--
medicenpringle

-----------------------------------------------------------------------
medicenpringles's Profile: http://www.excelforum.com/member.php...fo&userid=1645
View this thread: http://www.excelforum.com/showthread.php?threadid=38205


MrShorty[_8_]

Skipping cells in a Do Until loop
 

What's contained in C69? Is it empty/blank?

This is just an educated guess; I don't have a lot of experience wit
VBA. What little experience I have suggests that the conditional:
Until rgCopy = wsCopy.Range("C69") without any specification of exactl
what to compare in each range will compare the cells' values. So
assuming C69 is blank, when it finds a blank cell, blank=blank return
true, and it ends the loop. Step through a loop, with Watches fo
rgcopy and wscopy.range("C69") and rgcopy=wscopy.range("C69") and se
when the comparison returns TRUE.

If it were me, I would make the comparison more explicit as to when
wanted it to stop to avoid the ambiguity. Maybe something like Unti
rgcopy.row =69 or Until rgcopy.row=wscopy.range("C69").row t
explicitly state that I'm looping on the row number and not some othe
condition

--
MrShort
-----------------------------------------------------------------------
MrShorty's Profile: http://www.excelforum.com/member.php...fo&userid=2218
View this thread: http://www.excelforum.com/showthread.php?threadid=38205


Bernie Deitrick

Skipping cells in a Do Until loop
 
Stephen,

You need to describe your workbook, and show sample data. It appears that
you are simply trying to replace times entered as decimal hours with actual
times. Why are you skipping cells?

A SMALL sample of your data table would help. Put up, say, 2 columns by 10
rows of data, and what you want as a result, and it would be much easier to
code. When you say that the above pattern is repeated 14 times, where is it
repeated? On the next column? 2 columns over? 100 rows down?

HTH,
Bernie
MS Excel MVP



Here is my Code:




anilsolipuram[_107_]

Skipping cells in a Do Until loop
 

I think I have the second part, 1st part , need to give example to hav
clear picture

Sub CreateMirrorSchedule()

Dim wsCopy As Worksheet
Dim wsPaste As Worksheet
Dim rgCopy As Range
Dim rgPaste As Range

Application.ScreenUpdating = False

Set wsCopy = ThisWorkbook.Worksheets("Weekly Schedule")
Set wsPaste = ThisWorkbook.Worksheets("Schedule Mirror")
For i = 1 To 14
MsgBox i
Set rgCopy = wsCopy.Range("b9").Offset(0, i)
Set rgPaste = wsPaste.Range("b9").Offset(0, i)

wsCopy.Select

Do Until rgCopy = wsCopy.Range("b69").Offset(i, 0)
wsCopy.Select
If IsEmpty(rgCopy) Then
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
Else
rgCopy.Select
rgCopy.Copy
wsPaste.Select
rgPaste.PasteSpecial xlPasteValues
Select Case rgPaste.Value
Case Is < 1
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
Case 1
rgPaste.FormulaR1C1 = "1:00"
Case 1.25
rgPaste.FormulaR1C1 = "1:15"
Case 1.5
rgPaste.FormulaR1C1 = "1:30"
Case 1.75
rgPaste.FormulaR1C1 = "1:45"
Case 2
rgPaste.FormulaR1C1 = "2:00"
Case Else
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
End Select
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
End If
Loop
Next
'####### The above pattern is repeated 14 times
########

Set wsCopy = Nothing
Set wsPaste = Nothing
Set rgCopy = Nothing
Set rgPaste = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Su

--
anilsolipura
-----------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...fo&userid=1627
View this thread: http://www.excelforum.com/showthread.php?threadid=38205


medicenpringles[_10_]

Skipping cells in a Do Until loop
 

ok so specifically, the marco i wrote goes down column C and
performing the select statement for every other cell beginning wit
cell C9. my problem is, when i need it to return to the top of th
next column (or actually 2 columns over, but that part works) i have t
repeat the case and everything. also, when sees an empty cell, it skip
over the current loop and goes to the next, meaning it goes on to th
next column.


ok, so the first pic is where the user inputs data.

the second pic is without the hidden cells. the hidden rows ar
ESSENTIAL and must not be tampered with. i have already accomplishe
this; the macro perfroms the select statement for only the cells tha
are pictured in the first attachment.

my problem is, with the code above, the loop stops and goes 2 column
over (as i set in the Offset funtions) when it reaches an empty cell
such as cell C13. i need it to simply skip over this cell, set rgCop
and rgPaste to Offset(2,0) and keep going down the row till it reache
69th row, then

the third pic has cells rows 28 - 66 hidden, to show where i need th
macro to stop. that part works, but it i still have my othe
problems.

many thanks to any solution,
stephe

+-------------------------------------------------------------------
|Filename: schedule3gif.GIF
|Download: http://www.excelforum.com/attachment.php?postid=3538
+-------------------------------------------------------------------

--
medicenpringle

-----------------------------------------------------------------------
medicenpringles's Profile: http://www.excelforum.com/member.php...fo&userid=1645
View this thread: http://www.excelforum.com/showthread.php?threadid=38205


medicenpringles[_13_]

Skipping cells in a Do Until loop
 

can someone just tell me why a Do loop ends when it sees an empty cell?

when i run it in break mode, it loops until it reaches an empty cell,
then it highligts the "Do Until" line, and acts like it acheived the
parameter i set, even though it didn't. what's wrong?


--
medicenpringles


------------------------------------------------------------------------
medicenpringles's Profile: http://www.excelforum.com/member.php...o&userid=16458
View this thread: http://www.excelforum.com/showthread...hreadid=382056


anilsolipuram[_118_]

Skipping cells in a Do Until loop
 

try this

Sub CreateMirrorSchedule()

Dim wsCopy As Worksheet
Dim wsPaste As Worksheet
Dim rgCopy As Range
Dim rgPaste As Range

Application.ScreenUpdating = False

Set wsCopy = ThisWorkbook.Worksheets("Weekly Schedule")
Set wsPaste = ThisWorkbook.Worksheets("Schedule Mirror")
Set rgCopy = wsCopy.Range("C9")
Set rgPaste = wsPaste.Range("C9")

wsCopy.Select

Do Until rgCopy.address="$C$69"
wsCopy.Select
If IsEmpty(rgCopy) Then
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
Else
rgCopy.Select
rgCopy.Copy
wsPaste.Select
rgPaste.PasteSpecial xlPasteValues
Select Case rgPaste.Value
Case Is < 1
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
Case 1
rgPaste.FormulaR1C1 = "1:00"
Case 1.25
rgPaste.FormulaR1C1 = "1:15"
Case 1.5
rgPaste.FormulaR1C1 = "1:30"
Case 1.75
rgPaste.FormulaR1C1 = "1:45"
Case 2
rgPaste.FormulaR1C1 = "2:00"
Case Else
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
End Select
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
End If
Loop


'####### The above pattern is repeated 14 times
########

Set wsCopy = Nothing
Set wsPaste = Nothing
Set rgCopy = Nothing
Set rgPaste = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=382056



All times are GMT +1. The time now is 09:03 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com