I have Born Dates and want apply this formula
=(YEAR(NOW())-YEAR(A2))
in VBA for calculate age for whole row of dates
for example
A B
1 BornDate Age
2 09.06.1991 28
3 02.07.1973
4
5
my code works only for first two and stop without any error.
Sub btn_GetAge()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count).End(xlUp).Row
.Range("B2:B" & LastRow) = "=(YEAR(NOW())-YEAR(A1))"
End With
End Sub
Any idea or choose different formula ?
1) Cells requires a row and column, e.g. A1 is Cells(1,1)
2) Your formula (and better to specify the property) starts in row 2 but refers to A1
Sub btn_GetAge()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("B2:B" & LastRow).Formula = "=(YEAR(NOW())-YEAR(A2))"
End With
End Sub
You were very close:
Sub btn_GetAge()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("B2:B" & LastRow) = "=YEAR(TODAY())-YEAR(A2)"
End With
End Sub
Try:
Option Explicit
Sub Test()
Dim Lastrow As Long, i As Long
Dim CurrenctYear As Long, LoopYear As Long
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
CurrenctYear = Year(Now)
For i = 1 To Lastrow
LoopYear = Year(.Range("A" & i).Value)
.Range("A" & i).Offset(0, 1).Value = CurrenctYear - LoopYear
Next i
End With
End Sub
Related
I need column J to be filled with the value 1 in all cells until the rows that are filled in column A. Could someone provide me with the vba code for the same? Thanks in advance.
If you want to autofill 2010 until the row of column B with value 1:
Sub test()
Dim lastrow As Long
lastrow = Range("B" & Rows.Count).End(xlUp).Row
Range("A2:A" & lastrow).Value = 2010
End Sub
Give a try on below codes-
Sub FillCells()
Dim lr As Long, i As Long
Dim rng As Range
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lr
Cells(i, "J") = 1
Next i
End Sub
Please, try the next code line:
Range("J2:J" & Range("A" & rows.count).End(xlUp).row).Value = 1
Edited
You asked in a comment to another answer something about doing it for specific sheets.
Please, try the next way:
Dim ws As Worksheet, i As Long
For i = 2 To 5
Set ws = ActiveWorkbook.Worksheets(i)
ws.Range("J2:J" & ws.Range("A" & ws.rows.count).End(xlUp).row).Value = 1
Next i
I need to auto number rows if adjacent cell is not blank using VBA.
any one from below codes works perfectly , except if it counter blank cells.
as always, your support is much appreciated.
this the expected output
Sub Fill_Serial_Numbers_Option1()
Dim LastRow As Long
LastRow = Cells(Rows.count, "B").End(xlUp).Row
If LastRow > 2 Then
Range("A3:A" & Application.Max(2, LastRow)) = Evaluate("ROW(A1:A" & LastRow & ")")
End If
End Sub
Sub Fill_Serial_Numbers_Option2()
Dim LastRow As Long
LastRow = Cells(Rows.count, "B").End(xlUp).Row
If LastRow > 2 Then
With Range("A3:A" & LastRow)
.Cells(1, 1).value = 1
.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
End With
End If
End Sub
Please, test the next code:
Sub testCountNonBlanks()
Dim sh As Worksheet, lastR As Long, arr, arrA, count As Long, i As Long
Set sh = ActiveSheet
lastR = sh.Range("B" & sh.rows.count).End(xlUp).row: count = 1
If lastR <= 2 Then Exit Sub
arr = sh.Range("B2:B" & lastR).value 'place the range in an array for faster iteration
arrA = sh.Range("A2:A" & lastR).value
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then arrA(i, 1) = count: count = count + 1
Next i
sh.Range("A2").Resize(UBound(arrA), 1).value = arrA
End Sub
If a formula (written in VBA) is allowed, you can use the next variant:
Sub testCountByFormula()
Dim sh As Worksheet, lastR As Long, rngB As Range
Set sh = ActiveSheet
lastR = sh.Range("B" & sh.rows.count).End(xlUp).row
Set rngB = sh.Range("B2:B" & lastR)
sh.Range("A2:A10").Formula = "=IF(B2<>"""",COUNTA(" & rngB.Address & ")-COUNTA(" & rngB.Address(0, 1) & ")+1,"""")"
End Sub
You don't need a macro to accomplish this. Assuming all you care about is blank or not, then you can use a formula like this in cell A9. =Counta($B$1:$B9) If you have formulas you can try to leverage something with COuntif.
You can use a loop from the first row to the last one, something like this:
Sub Fill()
Dim LastRow As Long
Dim Count As Integer
Dim Row As Integer
Count = 0
Row = 1
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Do While Row <= LastRow
If Not (Cells(Row, 2) = "") Then
Count = Count + 1
Cells(Row, 1) = Count
End If
Row = Row + 1
Loop
End Sub
Sub MS()
Data = Sheets("Tabelle1").Select
Rows("1:1").Select
Rows("11409:11409").Select
Dim bilder As Long
Dim n As Long
Dim d As Long
Dim t As Long
bilder = 64
n = 1
d = 0
t = 0
'Dim i As Long
'For i = 1 To lastrow
Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row).Select
Range("b1:b" & Cells(Rows.Count, 1).End(xlUp).Row).Select
'Range("a1").Select
'Range("b1").Select
Range("a1,b1").Select
Do While ActiveCell.Value <> ""
Radius = Sqr(Range("A1").Value * Range("A1").Value + Range("B1").Value * Range("B1").Value)
ActiveCell.Offset(1, 1).Select
Loop
End Sub
I'm not sure why you'd want to do it this way (given that it can be done with a simple formula in-cell), but looking at the remnants of code in your question we can see what you're trying to achieve. Here's how I'd do it:
Sub MS()
Dim sht As Worksheet, StartRow As Long, LastRow As Long, OutputColumn As Long
Dim SideA As Double, SideB As Double, SideC As Double
With Worksheets("Tabelle1")
'Set StartRow to the first row of your data ignoring headers
StartRow = 2
'Locate LastRow as last occupied cell in column A
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Set OutputColumn to 3
OutputColumn = 3
'Start loop
For r = StartRow To LastRow
SideA = .Cells(r, 1).Value
SideB = .Cells(r, 2).Value
SideC = Sqr(SideA * SideA + SideB * SideB)
.Cells(r, OutputColumn).Value = SideC
Next
End With
End Sub
Output:
You do not need to select the range to work with it. You may want to see How to avoid using Select in Excel VBA
In your code you are not writing the output to any cell. Here are two ways that will help you achieve what you want.
NON VBA - WAY 1
Put the formula =SQRT(A1*A1+B1*B1) or =SQRT(A1^2+B1^2) in C1 and drag it down
VBA - WAY 2 (Without Looping)
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = Sheets("Tabelle1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("C1:C" & lRow)
.Formula = "=SQRT(A1*A1+B1*B1)"
.Value = .Value
End With
End With
End Sub
VBA - WAY 3 (Without Looping) Slightly complicated way of doing this. Explanation can be seen HERE
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = Sheets("Tabelle1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("C1:C" & lRow)
.Value = Evaluate("index(SQRT((A1:A" & lRow & _
")^2+(B1:B" & lRow & _
")^2),)")
End With
End With
End Sub
I have the following code
Sub copy()
Dim rngSource As Range
Dim copyCount As Long
With Sheets("Sheet1").Range("H2")
copyCount = .Value
Set rngSource = .EntireRow.Range("C1:F1")
End With
With Sheets("Sheet2").Range("A2")
.Resize(copyCount, rngSource.Columns.Count).Value = rngSource.Value
End With
End Sub
What it does: It copies the contents of the first row from C1 to F1 on sheet2 and multiplies the number of rows based on the value that H2 has. So if the cell H2 has the number 4, it takes all the cells from Sheet1 starting from C1 to F1 and makes 4 rows in Sheet2 with that.
Now I want it to do the same thing for each row that Sheet1 has as at the moment it only does the operation for 1 row.
I think the For Each loop would be required but I have tried several times and it failed me.
Any help is well received. Thank you!
Try the next code, please. I hope I correctly understood your need. If not, please better describe it...
Sub copySpecial()
Dim sh1 As Worksheet, sh2 As Worksheet, lastRow1 As Long, lastRow2 As Long, arrC As Variant
Dim copyCount As Long, i As Long
Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets("Sheet2")
lastRow1 = sh1.Range("C" & Rows.count).End(xlUp).row
For i = 2 To lastRow1
copyCount = sh1.Range("H" & i).Value
arrC = sh1.Range("C" & i & ":F" & i)
lastRow2 = sh2.Range("A" & Rows.count).End(xlUp).row + 1
If lastRow2 < 14 Then lastRow2 = 14
If copyCount > 0 Then
sh2.Range("A" & lastRow2).Resize(copyCount, 4).Value = arrC
End If
Next i
End Sub
Can anyone help me. I want to count how many of the numbers are > 45 and put the result 3 rows below the last data cell. Lets give it a name - call it result. Then to the left of result I would like to put the words Number > 45. The amount of data rows will change, so when I run the macro on column D it will find the last data point and do the calculation. Some of the rows will be empty. Thanks for the help
Its should like that this
50
20
100
120
45
30
30
Return >45= 4
Sub enter()
Dim result As Integer
Dim firstrow As Integer
Dim lastwow As Integer
Firstrow = d2
Result = ‘ Value of count
Worksheets("sheet1").Range("c?").Value = "Total>45"
Range("d100000").End(xlUp).Select
End Sub
Try this
Sub Sample()
Dim result As Long, firstrow As Long, lastrow As Long
Dim ws As Worksheet
Dim rng As Range
'~~> Set this to the relevant worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find Lastrow in Col D
lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
'~~> Set First row
firstrow = 1
'~~> Set your range
Set rng = .Range("D" & firstrow & ":D" & lastrow)
'~~> Put relevant values
.Range("C" & lastrow + 3).Value = "Total>45"
.Range("D" & lastrow + 3).Value = _
Application.WorksheetFunction.CountIf(rng, ">45")
End With
End Sub
Screenshot
Here's one that will let you pass in any number, not just 45
Sub MakeCount(lGreaterThan As Long)
Dim lLast As Long
With Sheet1
lLast = .Cells(.Rows.Count, 4).End(xlUp).Row
.Cells(lLast + 3, 4).FormulaR1C1 = "=COUNTIF(R[-" & lLast + 1 & "]C:R[-3]C,"">""&RC[-1])"
.Cells(lLast + 3, 3).Value = lGreaterThan
.Cells(lLast + 3, 3).NumberFormat = """Number>""#"
End With
End Sub
can't you use a worksheet formula like
=COUNTIF(A2:A7,">45")
alternatively, in VBA as Mr Siddharth Rout suggests in his answer
is vba required?
if not, the function =COUNTIF(C:C,">45") will give you the answer you want.