How do I automatically format a cell as I enter a value?
I divided the numbers into 3 categories: percentages, small numbers (-1000 - 1000), and large numbers.
I want percentages to be displayed with 2 decimals and the % sign.
Small numbers with 2 decimals as well.
And large numbers rounded to nearest integer, with thousands separators.
I want the code to reformat the cell if the cell value changes. For instance, if I change a cell with value "50,000", to 60%, then, it should be displayed as "60.00%".
Code I have so far applies formatting on existing cell values.
Sub myNumberFormat()
Dim cel As Range
Dim selectedRange As Range
Set selectedRange = Selection
For Each cel In selectedRange.Cells
If Not CStr(cel.Text) Like "*%*" Then
If Not IsEmpty(cel) Then
If cel.Value < 1000 And cel.Value > -1000 Then
cel.NumberFormat = "_(#,##0.00_);_(-#,##0.00_);_(""-""??_)"
Else
cel.NumberFormat = "_(#,##0_);_((#,##0);_(""-""??_)"
End If
End If
Else
cel.NumberFormat = "0.00%"
End If
Next cel
End Sub
A Worksheet Change: Apply Cell Formatting
This is a simple example for a single column, in this particular case, the range from A2 to the bottom-most cell in column A. But you can choose any reasonable cell address. In whatever cell you manually change (enter, copy/paste, or write using VBA) its value, the cell will be formatted according to your 'rearranged' procedure ApplyMySpecialNumberFormat.
Note that this works automatically, just copy the codes to the appropriate modules and start entering data into the cells of the range to see it work.
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' Define constants.
Const FirstCellAddress As String = "A2" ' adjust to any reasonable cell
' Reference the source column range e.g. 'A2:ALastWorksheetRow'.
Dim srg As Range '
With Me.Range(FirstCellAddress)
Set srg = .Resize(Me.Rows.Count - .Row + 1)
End With
' Reference the cells of the source range that have changed.
Dim irg As Range: Set irg = Intersect(srg, Target)
If irg Is Nothing Then Exit Sub ' no source range cells changed; exit
' At least one cell was changed:
ApplyMySpecialNumberFormat irg
End Sub
Standard Module e.g. Module1
Option Explicit
Sub ApplyMySpecialNumberFormat(ByVal rg As Range)
Dim cel As Range
For Each cel In rg.Cells
If CStr(cel.Text) Like "*%*" Then
cel.NumberFormat = "0.00%"
Else
If VarType(cel) = vbDouble Then ' is a number
If cel.Value < 1000 And cel.Value > -1000 Then
cel.NumberFormat = "_(#,##0.00_);_(-#,##0.00_);_(""-""??_)"
Else
cel.NumberFormat = "_(#,##0_);_((#,##0);_(""-""??_)"
End If
End If
End If
Next cel
End Sub
Related
I have a long list of equipment like this;
I would like to be able to run a VBA script that allows excel to change the format of the first of a series so that they are more visible. Is this a possibility?
This is housed in an excel table, not sure if that has an impact.
You could iterate through the range update format if below cell<>previous cell.
Sub UpdateCatHead(ByRef rng As Range, Optional col_index As Integer = 1)
Dim rng_search As Range
'lets ,make sure to have range of one column
Set rng_search = rng.Columns(col_index)
Dim cell As Range, prev_cell As Range
Dim prev_cat As String
For Each cell In rng_search.Cells
'check if empty is empty and exit for?
If cell.Row = 1 Then
'update cell to bold here
Debug.Print (cell.Row)
Else
Set prev_cell = cell.Worksheet.Cells(cell.Row - 1, cell.Column) 'cell above
If CStr(cell.Value) <> CStr(prev_cell.Value) Then
'update cell to bold here
Debug.Print (cell.Row)
End If
End If
Next cell
End Sub
call Sub like this:
UpdateCatHead ThisWorkbook.Sheets("data").Range("A1:A100")
Goodnight,
I have this code that identifies the ActiveCell and sends the value of that cell to "I6". With the change of the values that appear in "I6", the corresponding photographs of the students will change.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("I6").Value = ActiveCell.Value
End Sub
With this code, I get the value of the cell to appear in "I6" whenever I click on a cell in the table. As long as i click on the "I" column where the student numbers are, everything is fine.
The problem appears when I click on any other table cell ("I14:X43") outside this "I" column.
I needed the code to always identify column "I" (I4:I43) of the active cell row.
Thus, whenever you are entering a record in any cell of the table ("I14:X43"), the code will identify the column "I" of that line and its value (student number). Identifying the value found in column "I" of the active cell row, it will appear in "I6", as it is in this formula and was changing the students' photographs.
At this moment, when I write a value inside the table, it will be this value that will appear in "I6" carrying a photograph that corresponds to the value that was registered/written and not to the number of the student of the line where I am.
However, a friend helped me with this code which works for what I intended but only up to column "Z".
Sub_ Selectionchange
Dim x As String
Dim and As String
x = ActiveCell.Address(0, 0)
y = WorksheetFunction.Replace(x, 1, 1, "=I")
Range("I6").Value = y
End Sub
Clicking after that "Z" column, the code stops working and 0 appears in the "I6" column.
Can anyone help, please?
Try to getting a vba code to send the column "I" value of the ActiveCell row to cell "I6"
A Worksheet Selection Change: Trigger Worksheet Change
Option Explicit
Private Const ID_CELL As String = "I6"
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Me.Range(ID_CELL), Target) Is Nothing Then Exit Sub
' Your code for showing the student's image.
MsgBox "Like showing student's image for ID number " _
& CStr(Me.Range(ID_CELL).Value) & ".", vbInformation
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const ID_RANGE As String = "I14:I43"
Dim srg As Range: Set srg = Me.Range(ID_RANGE)
Dim rrg As Range: Set rrg = srg.EntireRow ' srg.EntireRow.Columns("I:X")
Dim irg As Range: Set irg = Intersect(rrg, Target)
If irg Is Nothing Then Exit Sub
Dim sCell As Range: Set sCell = Intersect(srg, irg.EntireRow).Cells(1)
Dim dCell As Range: Set dCell = Me.Range(ID_CELL)
' If not equal, write, triggering the Worksheet Change event.
If sCell.Value <> dCell.Value Then dCell.Value = sCell.Value
End Sub
Use the ActiveCell row and always use 9 => "I" column with Cells to get the value in column I in the same row of ActiveCell
Sub_ Selectionchange
Dim x As String
Dim and As String
Dim row as long
row = ActiveCell.row
If row >12 and row <44 Then
Range("I6").Value = cells(row,9).value
End If
End Sub
In a spreadsheet, I am trying to somehow make it so any new numerical value that gets inputted into a cell in column D to multiply by 85%. Basically, if I go to any cell 2-100,000 in column D and input a numerical value, I want it to automatically show 85% of it.
If I input '100' into D5, I want it to show '85'.
If I input '200' into D317, I want it to show '170'.
Is this possible to do in any way?
Manually multiplying by another cell or by 0.85 can't be used.
Thank you so much!
Worksheet Change: Modify Any Input in a Column
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim irg As Range
With Range("D2") ' from 'D2' to the bottom-most row:
Set irg = Intersect(.Resize(Rows.Count - .Row + 1), Target)
End With
If irg Is Nothing Then Exit Sub
Application.EnableEvents = False
Dim iCell As Range
For Each iCell In irg.Cells
If IsNumeric(iCell.Value) Then
iCell.Value = 0.85 * iCell.Value
End If
Next iCell
Application.EnableEvents = True
End Sub
I have a spreadsheet that has hidden rows 17-111. Data is added to three cells in each row (Columns P,Q & R).
The data comes from Userforms where the user has three option buttons to choose from. Depending on the option, the result of either "Pass", "Fail" or "NA" is populated into each of the cells in the range P17-R111.
I need to unhide all rows where "Fail" is in any of the P, Q or R column cells for that row.
e.g. If cell R57 is a "Fail" and cell P66 is "Fail", then the rows 57 and 66 need to be unhidden.
I have tried variations of code found searching the net, but I get a result where rows are unhidden only where column P has a "Fail", not where the P cell has no fail but other cells in the same row do.
e.g. If cell P57 has a "Pass", but cell R57 has a fail, the row remains hidden.
This is my latest (and more simple) attempt:
Private Sub CommandButton1_Click()
Dim cel As Range
Dim RangeToUnhide As Range
For Each cel In Worksheets("Sheet1").Range("P17:R111")
If cel = "Fail" Then
If RangeToUnhide Is Nothing Then
Set RangeToUnhide = cel
Else
Set RangeToUnhide = Union(RangeToUnhide, cel)
End If
End If
Next
RangeToUnhide.EntireRow.Hidden = False
End Sub
I tried changing the range to ("P17:P111") and then run two further copies of the code for ranges in Q and R. All I get is rows that unhide where the P cell is a 'Fail", the Q and R cells are ignored.
Use this Code
Sub Hide()
Dim cel As Range
Dim RangeToUnhide As Range
For Each cel In Worksheets("Sheet1").Range("A7:B11")
'Change Name of Sheet & Range as per your use
If cel = "A" Then
'Change Value as per your use
If RangeToUnhide Is Nothing Then
Set RangeToUnhide = cel
Else
Set RangeToUnhide = Union(RangeToUnhide, cel)
End If
End If
Next
RangeToUnhide.EntireRow.Hidden = True
End Sub
The above code is for hide use this for unhide
Sub Unhide()
Dim cel As Range
Dim RangeToUnhide As Range
For Each cel In Worksheets("Sheet1").Range("A7:B11")
'Change Name of Sheet & Range as per your use
If cel = "A" Then
'Change Value as per your use
If RangeToUnhide Is Nothing Then
Set RangeToUnhide = cel
Else
Set RangeToUnhide = Union(RangeToUnhide, cel)
End If
End If
Next
RangeToUnhide.EntireRow.Hidden = False
End Sub
I am trying to give the user the option to do simple arithmetic operations on selected cells.
The thing is that most cells are merged ranges.
I got the following already but the problem with it is that it loops through all cells while I only want it to only affect those cells that are not merged or only to the first cells of merged ranges.
Sub test()
Application.ScreenUpdating = False
Dim cel As Range
Dim selectedRange As Range
myValue = InputBox("Enter")
Set selectedRange = Application.Selection
For Each cel In selectedRange.Cells
On Error Resume Next
cel.Value = Evaluate(cel.Value & myValue)
Next cel
End Sub
Although VBasic2008's answer works, it's not totally correct. The problem is that each cell in merged range always returns True for MergedCells property. This means that excessive processing is done in a loop (i.e. incrementing a value) for cells other than top-left cell. To fix this situation, you should test each cell for the need to process. You can do this in several ways:
You can compare the address of a cell with the top-left cell address (Option 1 in code).
You can test the length of cell's value. If it's zero, then it's not top-left cell, so you skip it (Option 2 in code).
Code:
Sub IncrValues()
Dim rng As Range, myValue%
myValue = InputBox("Enter")
For Each cell In Selection
If cell.MergeCells Then
'// Option 1:
If cell.Address = cell.MergeArea(1).Address Then
cell.Value = cell.Value + myValue
End If
'// Option 2:
'If Len(cell) > 0 Then
' cell.Value = cell.Value + myValue
'End If
Else
cell.Value = cell.Value + myValue
End If
Next
End Sub
The MergeCells Property
Using the MergeCells property in an If statement, you check if a cell is not merged, then execute the following statement(s), otherwise the statement(s) after Else.
In the following example, the range I3:M12 is selected and 5 is entered as myValue. The first table is the state of the second table before.
The Code
Sub test()
Dim cel As Range
Dim selectedRange As Range
Dim myValue As Double
Application.ScreenUpdating = False
myValue = InputBox("Enter")
Set selectedRange = Application.Selection
For Each cel In selectedRange.Cells
If Not cel.MergeCells Then
' If not merged cell.
cel.Value = Evaluate(cel.Value & myValue)
Else
' if merged cell.
cel.Value = Evaluate(cel.Value + myValue)
End If
Next cel
Application.ScreenUpdating = True
End Sub
Count
We can expand the previous tables by adding a COUNT column,
where it is more obvious how the merged cells are being 'ignored' in Excel i.e. all cells except the first cell of a merged area will not be counted (or summed up, or ...).
The following shows the difference between counting the cells in VBA and in Excel.
Sub MergeTest()
With Range("J3:J12")
Debug.Print .Cells.Count
Debug.Print WorksheetFunction.Count(.Cells)
End With
With Range("J3:N12")
Debug.Print .Cells.Count
Debug.Print WorksheetFunction.Count(.Cells)
End With
End Sub
The results in the Immediate window are
10,
9,
50,
46,
which shows how VBA will count every cell, but Excel will exclude all cells of a merged area except the first.
In VBA Help search for the MergeArea property for some further info.