Sub UpperCase()
    
    Application.ScreenUpdating = False

    Dim cell As Range
  
    For Each cell In Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
        If Len(cell) > 0 Then cell = UCase(cell)
    Next cell
    
    Application.ScreenUpdating = True
    
End Sub