Calculating each row separately

[pauloalex]

I'm trying to create a sheet with some intervals in each row. The total of sums of the intervals of each row must be 08:00. But I'm having problems, because the excel doesn't calculate each row at time, but every row simultaneously, and the total in each row ends in a value different of 08:00.
Here my source:

Sub Macro1()

Range("C2:G32").Select
Selection.ClearContents


For Each linha In Range("A2:A32")

i = linha.Row

If Range("B" & i) = "Saturday" Then

Range("C" & i).Value = " "
Range("D" & i).Value = " "
Range("E" & i).Value = " "
Range("F" & i).Value = " "
Range("G" & i).Value = " "

ElseIf Range("B" & i) = "Sunday" Then

Range("C" & i).Value = " "
Range("D" & i).Value = " "
Range("E" & i).Value = " "
Range("F" & i).Value = " "
Range("G" & i).Value = " "

Else

While (Range("G" & i) <> "08:00")

Range("C" & i).Value = "=TEXT(RAND()*(TIME(8,16,0)-TIME(7,45,0))+TIME(7,45,0),""HH:MM"")"
Range("D" & i).Value = "=TEXT(RAND()*(TIME(12,16,0)-TIME(11,45,0))+TIME(11,45,0),""HH:MM"")"
Range("E" & i).Value = "=TEXT(RAND()*(TIME(13,46,0)-TIME(13,15,0))+TIME(13,15,0),""HH:MM"")"
Range("F" & i).Value = "=TEXT(RAND()*(TIME(17,46,0)-TIME(17,15,0))+TIME(17,15,0),""HH:MM"")"
Range("G" & i).Value = "=TEXT((D" & i & " - C" & i & ") + (F" & i & " - E" & i & "),""HH:MM"")"

Wend

End If

Next

End Sub

Here my file:
Month.xlsm

 

[rollis13]

You need to get rid of the formulas in the cells after updated them. Change the last part of your macro like this:

            ...
            While (Cells(i, 7) <> "08:00")
                Range("C" & i).Value = "=TEXT(RAND()*(TIME(8,16,0)-TIME(7,45,0))+TIME(7,45,0),""HH:MM"")"
                Range("D" & i).Value = "=TEXT(RAND()*(TIME(12,16,0)-TIME(11,45,0))+TIME(11,45,0),""HH:MM"")"
                Range("E" & i).Value = "=TEXT(RAND()*(TIME(13,46,0)-TIME(13,15,0))+TIME(13,15,0),""HH:MM"")"
                Range("F" & i).Value = "=TEXT(RAND()*(TIME(17,46,0)-TIME(17,15,0))+TIME(17,15,0),""HH:MM"")"
                Range("G" & i).Value = "=TEXT((D" & i & " - C" & i & ") + (F" & i & " - E" & i & "),""HH:MM"")"
                Range("C" & i & ":G" & i).Copy
                Range("C" & i).PasteSpecial Paste:=xlPasteValues
            Wend
        End If
    Next
    Application.CutCopyMode = False
    Range("A1").Select

End Sub

 

[pauloalex]

You need to get rid of the formulas in the cells after updated them. Change the last part of your macro like this:

            ...
            While (Cells(i, 7) <> "08:00")
                Range("C" & i).Value = "=TEXT(RAND()*(TIME(8,16,0)-TIME(7,45,0))+TIME(7,45,0),""HH:MM"")"
                Range("D" & i).Value = "=TEXT(RAND()*(TIME(12,16,0)-TIME(11,45,0))+TIME(11,45,0),""HH:MM"")"
                Range("E" & i).Value = "=TEXT(RAND()*(TIME(13,46,0)-TIME(13,15,0))+TIME(13,15,0),""HH:MM"")"
                Range("F" & i).Value = "=TEXT(RAND()*(TIME(17,46,0)-TIME(17,15,0))+TIME(17,15,0),""HH:MM"")"
                Range("G" & i).Value = "=TEXT((D" & i & " - C" & i & ") + (F" & i & " - E" & i & "),""HH:MM"")"
                Range("C" & i & ":G" & i).Copy
                Range("C" & i).PasteSpecial Paste:=xlPasteValues
            Wend
        End If
    Next
    Application.CutCopyMode = False
    Range("A1").Select

End Sub

Wooooow Man!

You are awesome! You solve the problem despite my bad English ? Thank you very much!!

You are Awesome!!

 

[rollis13]

I'm glad I've been of some help.
... and like this will be much faster:

        ...
        Else
            Application.ScreenUpdating = False
            While (Cells(i, 7) <> "08:00")
                Range("C" & i).Value = "=TEXT(RAND()*(TIME(8,16,0)-TIME(7,45,0))+TIME(7,45,0),""HH:MM"")"
                Range("D" & i).Value = "=TEXT(RAND()*(TIME(12,16,0)-TIME(11,45,0))+TIME(11,45,0),""HH:MM"")"
                Range("E" & i).Value = "=TEXT(RAND()*(TIME(13,46,0)-TIME(13,15,0))+TIME(13,15,0),""HH:MM"")"
                Range("F" & i).Value = "=TEXT(RAND()*(TIME(17,46,0)-TIME(17,15,0))+TIME(17,15,0),""HH:MM"")"
                Range("G" & i).Value = "=TEXT((D" & i & " - C" & i & ") + (F" & i & " - E" & i & "),""HH:MM"")"
            Wend
            Application.ScreenUpdating = True
            Range("C" & i & ":G" & i).Copy
            Range("C" & i).PasteSpecial Paste:=xlPasteValues
        End If
    Next
    Application.CutCopyMode = False
    Range("A1").Select
  
End Sub

 

[jasonb75]

If you write the values straight to the cells instead of the formulas then you don't need to copy and paste the values afterwards.

        ...
        Else
            Application.ScreenUpdating = False
            While (Cells(i, 7) <> "08:00")
                Range("C" & i).Value = Evaluate("=TEXT(RAND()*(TIME(8,16,0)-TIME(7,45,0))+TIME(7,45,0),""HH:MM"")")
                Range("D" & i).Value = Evaluate("=TEXT(RAND()*(TIME(12,16,0)-TIME(11,45,0))+TIME(11,45,0),""HH:MM"")")
                Range("E" & i).Value = Evaluate("=TEXT(RAND()*(TIME(13,46,0)-TIME(13,15,0))+TIME(13,15,0),""HH:MM"")")
                Range("F" & i).Value = Evaluate("=TEXT(RAND()*(TIME(17,46,0)-TIME(17,15,0))+TIME(17,15,0),""HH:MM"")")
                Range("G" & i).Value = Evaluate("=TEXT((D" & i & " - C" & i & ") + (F" & i & " - E" & i & "),""HH:MM"")")
            Wend
            Application.ScreenUpdating = True
        End If
    Next
End Sub

On a different note, looking at the rest of the code in the first post, it would be better not to have a space between the double quotes for the cells that you want to be blank.
The preferable method would be to clear contents on those cells with vba or to use double quotes with no space between them in a formula, that way you are less likely to run into problems later if you try to evaluate those cells as blank or empty.

 

[rollis13]

Yes @jasonb75, I keep forgetting the function Evalute.
But in this specific case I would not use it for column "G" because While (Cells(i, 7) <> "08:00") will no longer work since the cell will format HH:MM:SS causing the macro to loop.

 

[jasonb75]

@rollis13
I had missed the fact that the last cell being processed was the trigger for the loop.
With that in mind, I would say that it would be better to use your method so that all of the formulas are able to recalculate until the loop ends otherwise the values will never change and the loop will be infinite.

 

[rollis13]

@jasonb, it will also work as you suggested in your post #5 without the Evalute on the "G" column.

 

[jasonb75]

Ever had one of those days where 1+1=6 no matter how many times you do the math?

I was thinking it wouldn't work because it would need to recalculate, not re-evaluate

Yeah, I think I'm gonna keep quiet now, sneak out the back and hope nobody noticed I was here...