For some reason this loop doesn't call the sub formatCells to run on each cell in the selection. It will only run on the top left cell in the selected range.
Sub selectionLoop()
Dim rng As Range, itm As Range
Set rng = Selection
For Each itm In rng
Call formatCells
Next
End Sub
Sub formatCells() 'Formats cells based on what is in the cell
If WorksheetFunction.IsText(ActiveCell) = True Then 'Searching for text in the cell
With ActiveCell.Font 'Applies text format
.Name = "Calibri"
.Size = 18
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
.Bold = True
End With
With ActiveCell
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Else
ActiveCell.NumberFormat = "#,##0_);(#,##0)" 'Applies number format
End If
End Sub
Some improvements to your code:
IF
with Select Case
Option Explicit
Sub selectionLoop()
Dim targetRange As Range
Dim cell As Range
Set targetRange = Selection
' Loop through each cell in range
For Each cell In targetRange
' Pass the cell to procedure
formatCells cell
Next
End Sub
Private Sub formatCells(ByVal cell As Range) 'Formats cells based on what is in the cell
If WorksheetFunction.IsText(cell.Value) = True Then 'Searching for text in the cell
With cell.Font 'Applies text format
.Name = "Calibri"
.Size = 18
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
.Bold = True
End With
With cell
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Else
cell.NumberFormat = "#,##0_);(#,##0)" 'Applies number format
End If
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.