Skipping cells in a Do Until loop

[medicenpringles]

Here is my Code:

Please Login or Register  to view this content.

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:

Please Login or Register  to view this content.

) 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]

bump

no replies...

[MrShorty]

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

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

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

[Bernie Deitrick]

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]

I think I have the second part, 1st part , need to give example to have 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 Sub

[medicenpringles]

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


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

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

my problem is, with the code above, the loop stops and goes 2 columns 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 rgCopy and rgPaste to Offset(2,0) and keep going down the row till it reaches 69th row, then

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

many thanks to any solution,
stephen

[medicenpringles]

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?

[anilsolipuram]

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