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.
Related
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 am trying to populate 4 coulms and 130 rows from b2:b130 in display sheet using vlookup from bills sheet using rowid i created.
my data as in attached image.if anyone can help me with this that will be great.
Try the next code, please. It should be very fast and does not increase the workbook size like in case of formulas:
Sub copyRangeForSpecRows()
Dim firstRow As Long, lastRow As Long, shS As Worksheet, shD As Worksheet, El As Variant
Dim arrEX As Variant, arrGY As Variant, arrIZ As Variant, arrKAA As Variant
Dim pasteRow As Long, lastCopyRow As Long, arrRows As Variant, i As Long, k As Long
Set shS = Sheets("Bills") 'use here your sheet to copy from
Set shD = Sheets("Display")
firstRow = 5: lastRow = 130
pasteRow = CLng(shD.Range("T" & firstRow).Value)
lastCopyRow = CLng(shD.Range("T" & firstRow + lastRow).Value)
ReDim arrEX(1 To lastRow, 1 To 1): ReDim arrGY(1 To lastRow, 1 To 1)
ReDim arrIZ(1 To lastRow, 1 To 1): ReDim arrKAA(1 To lastRow, 1 To 1)
arrRows = shD.Range(shD.cells(firstRow, "T"), shD.cells(lastRow + firstRow - 1, "T")).Value
For i = pasteRow To lastCopyRow
For Each El In arrRows
If i = CLng(El) Then
k = k + 1
arrEX(k, 1) = shS.Range("X" & i).Value
arrGY(k, 1) = shS.Range("Y" & i).Value
arrIZ(k, 1) = shS.Range("Z" & i).Value
arrKAA(k, 1) = shS.Range("AA" & i).Value
End If
Next
Next i
shD.Range("E5:E" & 4 + lastRow).Value = arrEX
shD.Range("G5:G" & 4 + lastRow).Value = arrGY
shD.Range("I5:I" & 4 + lastRow).Value = arrIZ
shD.Range("K5:K" & 4 + lastRow).Value = arrKAA
MsgBox "Ready..."
End Sub
Based on how small scale this is and where you said you are just a starter with vba, I kept it simple(ish) while getting the desired result.
Commented for understanding.
Option Explicit
Sub populateData()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsDisp As Worksheet: Set wsDisp = wb.Worksheets("Display")
Dim wsBill As Worksheet: Set wsBill = wb.Worksheets("Bills")
Dim LastRow As Long
Dim i As Long
LastRow = wsDisp.Cells(wsDisp.Rows.Count, "B").End(xlUp).Row ' finds the last row in column B of the "Display" worksheet
On Error Resume Next ' bypasses errors such as unmatched values
For i = 1 To LastRow ' loop until the last row containing data
wsDisp.Cells(i, 5).Value = wsBill.Cells(Application.Match(wsDisp.Cells(i, 20).Value, wsBill.Range("W:W"), 0), 24) ' populates "GIDC Gas Paid" row in "Display" worksheet
wsDisp.Cells(i, 7).Value = wsBill.Cells(Application.Match(wsDisp.Cells(i, 20).Value, wsBill.Range("W:W"), 0), 25) ' populates "GST-GIDC Gas Paid" row in "Display" worksheet
wsDisp.Cells(i, 9).Value = wsBill.Cells(Application.Match(wsDisp.Cells(i, 20).Value, wsBill.Range("W:W"), 0), 26) ' populates "GIDC Booking Paid" row in "Display" worksheet
wsDisp.Cells(i, 11).Value = wsBill.Cells(Application.Match(wsDisp.Cells(i, 20).Value, wsBill.Range("W:W"), 0), 27) ' populates "GST-GIDC Booking Paid" row in "Display" worksheet
Next i ' iterates to the next number in the loop
End Sub
You should use index and Match function instead of Vlookup and if you want hard code then i will suggest you that go from row 1 to lastrow and check if both Sr.No and RowId match then take that data into an array and at the last paste the array data in Display Sheet.
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
I'm trying to perform a loop on my spreadsheet that works its way down the rows until it hits the last row in the datasheet.
I have a formula in cell P1 and I copy it into G1 and the loop works its way down infinitely to G200, G201, etc. How do I make it stop at the last row?
This is the code I have already tried.
Dim output As Worksheet
Dim Lastrow As Long
Dim i As Integer
i = 1
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
Set output = ThisWorkbook.Worksheets("Output")
output.Range("P1").Value = "=SUM(Q1,R1)"
Do Until Lastrow = True
output.Range("P1").Copy Destination:=output.Cells(i, 7)
i = i + 1
Loop
I currently have 21 rows of data (this is not static though) and it should loop essentially 21 times in this instance.
No loop needed:
Sub NU112()
Dim output As Worksheet
Set output = ThisWorkbook.Worksheets("Output")
Dim Lastrow As Long
Lastrow = output.Range("A" & output.Rows.Count).End(xlUp).Row
output.Range("G1:G" & Lastrow).Formula = "=SUM(Q1,R1)"
End Sub
For loops work better for looping through cells. I put everything in a with block so you don't need to constantly qualify ranges.
Dim output As Worksheet
Dim Lastrow As Long
Dim i As Integer
Set output = ThisWorkbook.Worksheets("Output")
with output
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
output.Range("P1").formula = "=SUM(Q1,R1)"
for i = 1 to lastrow
.Cells(i, 7).value = .cells(1, 16).value
next i
end with
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