Sub ChangeCase()
' ChangeCase is four VBA modules in one. See Subs below: TRIMnCLEAN(), ChangeCase(), REDnBOLD(), and DateChange().
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Formula Info" And ws.Name <> "Next Tech" Then
'If ws.Name <> "Formula Info" And ws.Name <>"Next Tech" Then Note: to add more just put (And ws.Name <> "name") before Then
' Change "Formula Info" sheet name or you can use sheet index# instead of name.
If ws.Cells(Rows.Count, 3).End(xlUp).Row > 2 Then
' The 3 in (Rows.Count, 3) tells this Subroutine to start in the 3rd row.
' This line was added to "fix" Error 400 which was caused by blank tab(s).
' The "Next Tech" tab has no data, and its header is in row 2.
' The part which returns the last row of data is: ws.Cells(Rows.Count, 3).End(xlUp).Row
' which will return 3 or more as long as the worksheet has data; thus subtracting 2 from
' this value returns any number from 1 upwards. However, when the worksheet has no data,
' the above code will return 2, and subtracting 2 from this = 0, which is an invalid row
' number in Excel. To check this, we test whether the value returned by the above code
' is greater than 2; if so, we proceed further, else we exit.
'ONE-------------------------------------
' Sub TRIMnCLEAN()
With ws.[A3:D3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row - 2)
' > > > This VBA removes leading and trailing spaces in the array of Columns A through D.
' A3:D3 array tells where to apply change(s). (Rows.Count, 3) tells in which column to start.
' .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(#),"""")", "#", .Address)) yields only removing leading and trailing spaces.
' Added CLEAN to remove leading and trailing ASCII characters 0-31.
.Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(CLEAN(#)),"""")", "#", .Address))
End With
' End Sub
'TWO-------------------------------------
' Sub ChangeCase()
With ws.[E3:F3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row - 2)
' > > > This VBA changes all characters in the array defined by Columns E and F to UPPER case.
' E3:F3 array tells where to apply change(s). (Rows.Count, 3) tells in which column to start.
.Value = .Parent.Evaluate(Replace("IF(#>"""",UPPER(#),"""")", "#", .Address))
End With
' End Sub
'THREE----------------------------------- Immediate ?workbooks.Count
' Sub REDnBOLD()
For Each cll In ws.Range(ws.Cells(3, "C"), ws.Cells(ws.Rows.Count, "C").End(xlUp)).Cells
' > > > This VBA segment changes the TV Model screen size between 70 and 90 inches to red and Bold and
' starts in Row 3, Column C, and applies to each tab in the Excel workbook, except for tab "Formula Info" tab.
With cll
x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
If x > 0 Then
y = CLng(Mid(cll.Value, x, 2))
If y >= 70 And y <= 90 Then
With .Characters(Start:=x, Length:=2).Font
.FontStyle = "Bold"
.Color = -16776961
End With
End If
End If
End With
Next cll
' End Sub
'FOUR-----------------------------------
' Sub DateChange()
' constants
' Const ksFormat = "mm/dd/yyyy"
' > > > This VBA segment changes the dates in Column G from whatever the format happens to be to "mm/dd/yyyy"
' declarations
Dim lRow As Long, iColumn As Integer, lRowest As Long
' start 1Row starts at row 3, iColumn starts at column G(7)
lRow = 3
iColumn = 7
' process
With ws
lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row
Do While lRow <= lRowest
' Debug.Print lRow
With .Cells(lRow, iColumn)
' If Len(.Cells(lRow, iColumn).Value) > 0 Then
If .NumberFormat <> "mm/dd/yyyy" Then .NumberFormat = "mm/dd/yyyy"
lRow = lRow + 1
End With
Loop
End With
' end
' End Sub
'FIVE------------------------------------ Columns("E:E").NumberFormat = "$#.##0"
' Sub CurrencyFix()
' Dim lRow As Long, iColumn As Integer, lRowest As Long
' Dim ws As Worksheet
' start 1Row starts at row 3, iColumn starts at column H(8)
lRow = 3
iColumn = 8
' process
With ws
lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row
Do While lRow <= lRowest
' Debug.Print lRow
With .Cells(lRow, iColumn)
' If Len(.Cells(lRow, iColumn).Value) > 0 Then
If .NumberFormat <> "$#,##0" Then .NumberFormat = "$#,##0"
lRow = lRow + 1
End With
Loop
End With
' End Sub
'BEEPS-----------------------------------
End If
End If
Next
Beep
' Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
Application.Wait Now + TimeValue("0:00:01")
Beep
' Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
Application.Wait Now + TimeValue("0:00:01")
Beep
End Sub
Sub Tabs_Colors_Off()
Application.ScreenUpdating = False
s_tab = Worksheets.Count
For Each s In [{3,4,5,6,7,8,9,10,11,12,13,14,16,17,18}] 'To avoid an error message, these numbers must match the actual numbers of Tabs.
Sheets(s).Tab.ColorIndex = xlNone
Next s
End Sub