So if we have a number, 99999.23412343 I'm hoping to get it to display 99,999.23 In other words, having a thousands separator comma and 2 decimal places rounded.
I have this code here, which makes values cosmetically look that way, but it doesn't actually round the number. is there a way to add rounding to this calculation or make the values themselves be 2 decimals?
Sub roundcode()
Columns("G:G").Select
Selection.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(#_)"
End Sub
This will apply both actual rounding as well as format rounding:
Sub roundd()
Dim rng As Range, cell As Range
Set rng = Intersect(Columns("G:G"), ActiveSheet.UsedRange)
With Application.WorksheetFunction
For Each cell In rng
If cell.HasFormula Then
txt = "(" & Mid(cell.Formula, 2) & ")"
cell.Formula = "=ROUND(" & txt & ",2)"
Else
cell.Value = .Round(cell.Value, 2)
End If
Next cell
End With
rng.NumberFormat = "#,000.00"
End Sub
It will handle both formulas and constants.
EDIT#1:
to avoid the first row, replace:
Columns("G:G")
with something like:
Range("G2:G999999")
EDIT#2:
Try this instead:
Sub roundd()
Dim rng As Range, cell As Range
Set rng = Intersect(Range("G2:G999999"), ActiveSheet.UsedRange)
With Application.WorksheetFunction
For Each cell In rng
If cell.HasFormula Then
txt = "(" & Mid(cell.Formula, 2) & ")"
cell.Formula = "=ROUND(" & txt & ",2)"
Else
If cell.Value <> "" Then
cell.Value = .Round(cell.Value, 2)
End If
End If
Next cell
End With
rng.NumberFormat = "#,000.00"
End Sub
I have no idea what that format is supposed to do. If you want thousands with two decimal places simply use:
Columns("G:G").NumberFormat = "#,000.00"
No need to Select to format. For a good reference for all number, time, date formats use the following link https://peltiertech.com/Excel/NumberFormats.html
Related
I already tried using this code and its not working
Sub Bold()
With Sheets("1470")
For Each Cell In Range("J:J")
If Cell.Value = "N/A" Then
Cell.Font.bold = True
End If
Next Cell
End With
End Sub
the output that I want to execute is every cell in column J that contains "N/A" gets bold
I got error
"Type mismatch"
Do not use J:J It will slow your code. Find the last row and then check in that range.
To specifically check for #N/A use CVErr() as shown below.
If you want to check for any error then go with IsError() as mentoned by #PawelCzyz.
Is this what you are trying?
With Sheets("1470")
lrow = .Range("J" & .Rows.Count).End(xlUp).Row
For Each cell In Range("J1:J" & lrow)
If CVErr(cell.Value) = CVErr(xlErrNA) Then
cell.Font.Bold = True
End If
Next cell
End With
This answer is based on the assumption you looking for #N/A errors on your worksheet caused by the same formulas in that column.
Sub Test()
Dim rng1 As Range, rng2 As Range
With ThisWorkbook.Sheets("1470")
Set rng1 = .Range("J1:J" & .Range("J" & .Rows.Count).End(xlUp).Row)
If .Evaluate("=SUM(--ISNA(" & rng1.Address & "))") > 0 Then
Set rng2 = Intersect(rng1, rng1.SpecialCells(xlCellTypeFormulas, xlErrors))
rng2.Font.Bold = True
End If
End With
End Sub
I'm trying to add an apostrophe to the front of numbers in a column only if the number in the column begins with a "0." There are a mix of many different numbers in the column, however for numbers which do not start in zero, I do not want an apostrophe added.
Sub RANGE
For Each Cell in Range ("E:E")
If cell.value= starts with a 0 then Cell.value = " ' "
Sub Addapostrophe()
For Each cell In Selection
cell.Value = "'" & cell.Value
Next cell
End Sub
This will work...
Sub Addapostrophe()
Dim rng As Range
Set rng = Range("E:E")
For Each cell In rng
If Left(cell.Value, 1) = 0 Then
cell.Value = "'" & cell.Value
End If
Next
End Sub
So i have this sheet where i'd like to apply a formula every 7th row. But it can't be the same formula, it needs to "offset" the formula as well.
For example, for the first range the formula would be "=(C4+C5)-C3"; for the second range, "=(C11+C12) - C10"; and so on.
This is what i have so far:
Sub ApplyFormula()
ApplyCF Range("C6")
ApplyCF Range("C13")
'and so on, every 7 rows
'is there any other way i can apply these ranges instead of typing them?
'with an offset formula or something like that.
End Sub
Sub ApplyCF(rng As Range)
rng.Formula = "=(C4+C5)-C3"
'i'd like the macro to "offset" the formula,
'so for the C13 Range it would be "=(C11+C12) - C10"
End Sub
For your ApplyCF sub, you could do this:
Sub ApplyCF(rng As Range)
If rng.Count <> 1 Then Exit Sub ' in case your range is more than one cell
Dim prevCell As Range, twoPrevCell As Range, threePreCell As Range
Set prevCell = rng.Offset(-1, 0)
Set twoPrevCell = rng.Offset(-2, 0)
Set threeprevcell = rng.Offset(-3, 0)
rng.Formula = "=(" & twoPrevCell & "+" & prevCell & ")-" & threeprevcell
End Sub
It could definitely be tweaked, for instance, do you need to see the formula in the Formula Bar? We can evaluate that math in VBA and just put the answer in.
Per your comment, try this for every 6th cell (it's the whole macro, no need to split them):
Sub test()
' I assume you want to run this for every 6th cell in column C, starting with C1
Dim lastRow As Long
lastRow = Cells(Rows.Count, 3).End(xlUp).Row ' gets us our last row in column C with data
Dim cel As Range, rng As Range
For i = 6 To lastRow Step 6 'have to start at row 4, since any other row less than that messes up the formula
Cells(i, 3).Select ' because you can't have row 3-3
Cells(i, 3).Formula = "=(" & Cells(i - 2, 3).Address & "+" & Cells(i - 1, 3).Address & ")-" & Cells(i - 3, 3).Address
Next i
End Sub
If the formula needs to be displayed. Edited. Code below will work! you need to use the parmateter "address" to reference a cell. the parameters false or true are here to say if one needs the relative (Set to false) or absolute (set to true) referernce
Sub ApplyCF(rng As Range)
rng.Formula = "=(" & rng.Offset(-2, 0).Address(False, False) & _
"+" & rng.Offset(-1, 0).Address(False, False) & ")-" & rng.Offset(-3, 0).Address(False, False)
End Sub
I am tying to manage duplicates on an Excel sheet by having the duplicate cells turn red. I put this in a use to sheet protection to keep from editing the conditional formatting for these columns. However, when I move the cell information (by clicking and dragging) the conditional formatting moves from that cell as well. At the end of the day, I do not have duplicate coverage for every cell that I want. Is there some way I can prevent this from happening when I move the cell, or what macro can I put in to take care of this?
I want to do something like this using VBA:
Sub Duplicate()
Dim rngData As Range
Dim cell As Range
Set rngData = Range("P3:P19, P56:P58, P39:P42, P21:P25, P27:P37, P39:P42, P39:P42, P44:P54, M25:M76, B69:B77, B66:E67, B51:B64, H44:H47, D44:D47, H42, H33:H40, D33:D42, H31, D28:D31, H28:H29, D5:D8" & Cells(Rows.Count, "B").End(xlUp).Row)
For Each cell In rngData
cell.Offset(0, 0).Font.Color = vbBlack ' DEFAULT COLOR
' LOCATE DUPLICATE VALUE(S) IN THE SPECIFIED RANGE OF DATA.
If Application.Evaluate("COUNTIF(" & rngData.Address & "," & cell.Address & ")") > 1 Then
cell.Offset(0, 0).Font.Color = vbRed ' CHANGE FONT COLOR TO RED.
End If
Next cell
Set rngData = Nothing
Application.ScreenUpdating = True
End Sub
But I get a "Type Mismatch" error at:
If Application.Evaluate("COUNTIF(" & rngData.Address & "," & cell.Address & ")") > 1 Then
How can I get around this?
As per comment you would need to loop twice:
Sub Duplicate()
Dim rngData As Range
Dim cell As Range
Dim cell2 As Range
Set rngData = Range("P3:P19, P56:P58, P39:P42, P21:P25, P27:P37, P39:P42, P39:P42, P44:P54, M25:M76, B69:B77, B66:E67, B51:B64, H44:H47, D44:D47, H42, H33:H40, D33:D42, H31, D28:D31, H28:H29, D5:D8" & Cells(Rows.Count, "B").End(xlUp).Row)
rngData.Font.Color = vbBlack
For Each cell In rngData
If cell.Font.Color = vbBlack Then
For Each cell2 In rngData
If cell = cell2 And cell.Address <> cell2.Address Then
cell.Font.Color = vbRed
cell2.Font.Color = vbRed
End If
Next
End If
Next
Set rngData = Nothing
Application.ScreenUpdating = True
End Sub
I have many cells that have #DIV/0! so I need to put the IFERROR function. Is there a way to apply this formula to all cells instead of putting the formula manually in every cell?
I tried this VBA code but I am looking for something more simple.
Sub WrapIfError()
Dim rng As Range
Dim cell As Range
Dim x As String
If Selection.Cells.Count = 1 Then
Set rng = Selection
If Not rng.HasFormula Then GoTo NoFormulas
Else
On Error GoTo NoFormulas
Set rng = Selection.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
End If
For Each cell In rng.Cells
x = cell.Formula
cell = "=IFERROR(" & Right(x, Len(x) - 1) & "," & Chr(34) & Chr(34) & ")"
Next cell
Exit Sub
'Error Handler
NoFormulas:
MsgBox "There were no formulas found in your selection!"
End Sub
Can anyone help me?
Perhaps one of these versions will be easier to teach.
Sub apply_Error_Control()
Dim cel As Range
For Each cel In Selection
If cel.HasFormula Then
'option 1
cel.Formula = Replace(cel.Formula, "=", "=IFERROR(", 1, 1) & ", """")"
'option 2
'cel.Formula = "=IFERROR(" & Mid(cel.Formula, 2) & ", """")"
End If
Next cel
End Sub
I've supplied two ways to apply the IFERROR function as a 'wapper' for error control. To use the second option, comment the first and uncomment the second.
Select one or more cells and then run the macro; typically though Alt+F8 then Run from the worksheet.