Sub UpperCase()
    
    Application.ScreenUpdating = False

    Dim cell As Range
    For Each cell In Range("$B$1:B" & Range("$B$1").SpecialCells(xlLastCell).row)
        If Len(cell) > 0 Then cell = UCase(cell)
    Next cell
    
    Application.ScreenUpdating = True
    
End Sub
or using mumps version
Sub UpperCase()
    
    Application.ScreenUpdating = False

    Dim cell As Range
    For Each cell In Range("$B$1:B" & Range("B" & rows.count).end(xlup).row)
        If Len(cell) > 0 Then cell = UCase(cell)
    Next cell
    
    Application.ScreenUpdating = True
    
End Sub