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
Related
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
I've defined a couple of ranges but have problems to define a new range with a few conditions. I'm trying to set a new range from target cell downwards until the length of first TRUE cell is larger than 3 characters. The new desired range would be "Range("C" & Target.Row & ":" & Range("C65536").End(xlDown).Address(0, 0))" but only for the for the cells that have 3 or less characters. The problem with that code is that it stops at the first non-empty cell. The final cell in the range would be the last cell with max 3 characters (and not empty) before a cell value has more than 3 characters.
For instance the new range would be C35:C47 which would then be applied for the adjacent cells as B35:B47. Later on in my code I would then use this new range (B35:B47) in a "for loop" to define new values for these adjacent cells.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim rng As Range, cell As Range
Set rng = Range("B" & Target.Row & ":" & Range("B65536").End(xlUp).Address(0, 0))
Set r = Target
If Target.Column = 3 And Selection.Column = 3 Then
If Intersect(Range("C:C"), r) Is Nothing Then Exit Sub
If r.Value = "" Then Exit Sub
If r.Offset(0, 1).Value <> "" Then Exit Sub
If r.Offset(0, -1).Value <> "" Then Exit Sub
Application.EnableEvents = False
r.Offset(0, -1) = Application.WorksheetFunction.Max(Range("Sheet1!B7:B" & r.Row))
For Each cell In rng
If IsNumeric(cell.Value) Then
If cell.Value <> "" Then
cell.Value = cell.Value + 1
End If
Else
MsgBox "Cell " & cell.Address(0, 0) & " does not have a number"
Exit Sub
End If
Next
Application.EnableEvents = True
End If
End Sub
The new range would then be used in a similar way as the "for-loop" in the example with the difference that "rng" would be the new range --> "For Each cell in rng2"...
I'd appreciate any help as I have no experience in vba.
What I'm trying to do
is that at the sheet "data" when the selected cell belongs to the rng1 then
the value for example 020318 at the cell changes to take the format 02/03/18.
At the same time in column ED at each cell there is a sum formula.
When this sum is under zero then a msgbox should pop up
for example
Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim rng1 As Range
Dim rng2 As Range
Dim cell As Range
Set rng1 = ThisWorkbook.Sheets("DATA").Range("I3:I1000,O3:O1000,P3:P1000,AE3:AE1000,AF3:AF1000,AH3:AH1000,AI3:AI1000")
Set rng2 = ThisWorkbook.Sheets("DATA").Range("ED3:ED1000")
If Not Intersect(ActiveCell, Range("I3:I1000,O3:O1000,P3:P1000,AE3:AE1000,AF3:AF1000,AH3:AH1000,AI3:AI1000")) Is Nothing Then
For Each cell In rng1
If cell <> "" Then
If Len(cell) = 6 Then
cell.Value = Format(cell.Value, "00/00/00")
End If
End If
Next cell
For Each cell In rng2
If IsNumeric(cell) = True Then
If cell.Value < 0 Then MsgBox "Τhe salary " & Cells(cell.Row, 2).Value & " before ....is " & Cells(cell.Row, 3).Value & " try more", vbCritical, "XXXXX"
End If
Next cell
End Sub
thanks in advance
How can I create a macro that will add a day in one cell and subtract a day in another cell at the same time? Here is what I have so far.
Sub ChangeDates()
Dim cell As Range
For Each cell In Range("B:B")
cell.Value = cell.Value + 1
Next cell
For Each cell In Range("C:C")
cell.Value = cell.Value - 1
End Sub
I know you've accepted an answer, but I would like to offer this approach, which is even faster and more efficient than looping through all those cells.
If your dates are in Column A, then Column B will hold date +1 and Column C will hold date -1
Option Explicit
Sub ChangeDates()
Dim myRange As range
Dim mySheet As Worksheet
Set mySheet = Sheets("Sheet7") 'change to your sheet
With mySheet
Set myRange = .range("A1:A" & .range("A" & .Rows.Count).End(xlUp).Row)
myRange.Offset(, 1).FormulaR1C1 = "=RC[-1]+1"
myRange.Offset(, 2).FormulaR1C1 = "=RC[-2]-1"
End With
End Sub
Offset to the rescue!!
Sub ChangeDates()
Dim cell As Range
For Each cell In Range("B:B")
cell.Value = cell.Value + 1
cell.offset(0,1).value = cell.offset(0,1).value - 1
Next cell
End Sub
Another thing you may consider is either looking at usedrange to not have to iterate through all of column B or put in a check to make sure the cells aren't blank... Just faster, better coding and stops you from having bad values where the cells were originally blank...
Sub ChangeDates()
Dim cell As Range
For Each cell In Intersect(Range("B:B"), ActiveSheet.UsedRange)
cell.Value = cell.Value + 1
cell.Offset(0, 1).Value = cell.Offset(0, 1).Value - 1
Next cell
End Sub
I need to find out the first cell and the last cell of a vertically merged cell..
Let's say I merge Cells B2 down to B50.
How can I get in VBA the start cell(=B2) and the end cell(=B50)?
Sub MergedAreaStartAndEnd()
Dim rng As Range
Dim rngStart As Range
Dim rngEnd As Range
Set rng = Range("B2")
If rng.MergeCells Then
Set rng = rng.MergeArea
Set rngStart = rng.Cells(1, 1)
Set rngEnd = rng.Cells(rng.Rows.Count, rng.Columns.Count)
MsgBox "First Cell " & rngStart.Address & vbNewLine & "Last Cell " & rngEnd.Address
Else
MsgBox "Not merged area"
End If
End Sub
Below macro goes through all sheets in a workbook and finds merged cells, unmerge them and put original value to all merged cells.
This is frequently needed for DB applications, so I wanted to share with you.
Sub BirlesenHucreleriAyirDegerleriGeriYaz()
Dim Hucre As Range
Dim Aralik
Dim icerik
Dim mySheet As Worksheet
For Each mySheet In Worksheets
mySheet.Activate
MsgBox mySheet.Name & “ yapılacak…”
For Each Hucre In mySheet.UsedRange
If Hucre.MergeCells Then
Hucre.Orientation = xlHorizontal
Aralik = Hucre.MergeArea.Address
icerik = Hucre
Hucre.MergeCells = False
Range(Aralik) = icerik
End If
Next
MsgBox mySheet.Name & " Bitti!!"
Next mySheet
End Sub
Suppose you merged B2 down to B50.
Then, start cell address will be:
MsgBox Range("B2").MergeArea.Cells(1, 1).Address
End cell address will be:
With Range("B2").MergeArea
MsgBox .Cells(.Rows.Count, .Columns.Count).Address
End With
You can put address of any cell of merged area in place of B2 in above code.
Well, assuming you know the address of one of the cells in the merged range, you could just select the offset from that range and get the row/column:
Sub GetMergedRows()
Range("A7").Select 'this assumes you know at least one cell in a merged range.
ActiveCell.Offset(-1, 0).Select
iStartRow = ActiveCell.Row + 1
Range("A7").Select
ActiveCell.Offset(1, 0).Select
iEndRow = ActiveCell.Row - 1
MsgBox iStartRow & ":" & iEndRow
End Sub
The code above will throw errors if the offset row cannot be selected (i.e. if the merged rows are A1 through whatever) so you will want to add error handling that tells the code if it can't offset up, the top rows must be 1 and if it can't go down, the bottom row must be 65,536. This code is also just one dimensional so you might want to add the x-axis as well.
If you want the cell references as strings, you can use something like this, where Location, StartCell, and EndCell are string variables.
Location = Selection.Address(False, False)
Colon = InStr(Location, ":")
If Colon <> 0 Then
StartCell = Left(Location, Colon - 1)
EndCell = Mid(Location, Colon + 1)
End If
If you want to set them as ranges, you could add this, where StartRange and EndRange are Range objects.
set StartRange = Range(StartCell)
set EndRange = Range (EndCell)
If you intend to loop through the merged cells, try this.
Sub LoopThroughMergedArea()
Dim rng As Range, c As Range
Set rng = [F5]
For Each c In rng.MergeArea
'Your code goes here
Debug.Print c.Address'<-Sample code
Next c
End Sub