View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
medicenpringles[_8_] medicenpringles[_8_] is offline
external usenet poster
 
Posts: 1
Default 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