I need a loop to shorten code

[Ace71425]

See code below...
This code checks range c2 in worksheet Hours and based on the value it prints the text HOURS to the next available D cell in worksheet Work. It works but it's too long as it goes up to 14. I need decimals involved too so if it's for example 3.25 or 3.5 it rounds down and prints 3 HOURS if its 3.75 it round up and prints 4 HOURS. Please let me know if you know of a loop to check through .25 to 14 and print the appropriate amount of HOURS text...Thank you in advance!

Set sh = wb.Sheets("Hours")


    If sh.Range("c2") = "0.25" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")


    If sh.Range("c2") = "0.5" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")


    If sh.Range("c2") = "0.75" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If


Set sh = wb.Sheets("Hours")


    If sh.Range("c2") = "1" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")


    If sh.Range("c2") = "1.25" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")


    If sh.Range("c2") = "1.5" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")


    If sh.Range("c2") = "1.75" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")
    
    If sh.Range("c2") = "2" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")

 

[mumps]

Try:

Sub Test()
    Application.ScreenUpdating = False
    Dim bottomD As Long
    bottomD = Sheets("Work").Range("D" & Rows.Count).End(xlUp).Row
    Sheets("Work").Range("D" & bottomD + 1 & ":D" & bottomD + Math.Round(Sheets("Hours").Range("C2"), 0)) = "HOURS"
    Application.ScreenUpdating = True
End Sub

 

[Ace71425]

That's exactly what i'm looking for BUT this code is on a master book that opens up another workbook and writes the hours on that workbook..I can only get your code to write it on the activeworkbook that the code is placed in...How can I make it write it to another workbook that is open?

 

[Ace71425]

I tried a with statement referencing the path of the other sheet but that didnt work

 

[Ace71425]

Ok nevermind I figured it out...the only other thing I have a problem with is I need it round down .25 and .5 and round up .75 whereas it rounds up .5 anyway to fix that?

 

[mumps]

See if this works for you.

Sub Test()
    Application.ScreenUpdating = False
    Dim bottomD As Long
    bottomD = Sheets("Work").Range("D" & Rows.Count).End(xlUp).Row
    If "." & Split(Sheets("Hours").Range("C2"), ".")(1) <= 0.5 Then
        Sheets("Work").Range("D" & bottomD + 1 & ":D" & bottomD + Int(Sheets("Hours").Range("C2"))) = "HOURS"
    ElseIf "." & Split(Sheets("Hours").Range("C2"), ".")(1) > 0.5 Then
        Sheets("Work").Range("D" & bottomD + 1 & ":D" & bottomD + Int(Sheets("Hours").Range("C2") + 1)) = "HOURS"
    End If
    Application.ScreenUpdating = True
End Sub