I'm trying to loop trough each row in the range J16:P19, and with every iteration, it must be checked if the value in the cell = 3, and if the text in the corresponding coloumn (range J15:J19) is present in the range ( W1:W7).
eg. If the cell (K17) in the row (J17:P17) = 3 & the corresponding coloumn name (K15) of that cell is present in the range ( W1:W7); the value of in Q17 must be substracked by 1.
This should be done for every row in the range. My code looks like this:
private Sub CommandButton2_Click()
dim rng As Range
dim i As Range
dim row As Range
Set rng = Range("j16:p19")
For Each row In rng.Rows
For Each i In row.Cells
If i.Value = 3 & Cells(i,15) %in% Range("w1:w7") Then
Cells(row,22).Value = Cells(row,17).Value -1
Else
Cells(row,22).Value = Cells(row,17).Value
End if
Next i
Next row
End sub
It works when I select the range to be one column only, and without the second part of the if statement. Do you have any suggestions on have to solve my problem? thank you in advance
Try this.
Not sure why you were referring to column 22? Also "%in%" is not valid VBA syntax. I've used Match instead (which avoids the outer loop), but you could use Find or Countif.
Private Sub CommandButton2_Click()
Dim rng As Range
Dim i As Range
Dim row1 As Range, v As Variant 'better in my view not to call a variable "row"
Set rng = Range("j16:p19")
For Each row1 In rng.Rows
v = Application.Match(3, row1, 0)
If IsNumeric(v) Then 'row contains a 3
If IsNumeric(Application.Match(Cells(row1.row,"J"), Range("W1:W7"), 0)) Then 'corresponding J column value in W1:W7
Cells(row1.row, "Q").Value = Cells(row1.row, "Q").Value - 1 'deduct 1 from Q
End If
End If
Next row1
End Sub
The goal for this function in to sum specific cells in a range depending on the value and position of other cells in a different range.
Here is an image so it is more clear:
The answer for Column M would be = 2+4+6+9 = 21
The answer for Column P would be = 3+7+10 = 20
There are 20 different "Precio, Precio2, Precio3,..." that are under "Licitante 1, Licitante 2, ..." which is why I used CASES.
Recap, if a cell in column "M" is >0 then the function should select the cell on column "H" which is on the same row, do this for all the cells in said range and add them.
I have this so far:
Function ImporteLic(lic As String)
Dim cell As Range
Dim i As Integer
Select Case lic
Case "Licitante 1"
For Each cell In Range("M13:M50")
If ActiveCell.Value > 0 Then
ActiveCell.Offset(0, -5) = i
End If
Next cell
ImporteLic = worksheetfuntion.Sum(i)
End Select
End Function
I guess i am missing something in the part where all the cells that meet the criteria add up.
Thank you for your help.
There's a ton of issues with the code you posted. Try this and see if works.
Function ImporteLic(lic As String) As Double
With Worksheets("Sheet1") 'change name
Dim col As Long
col = .Rows(1).Find(lic, lookat:=xlWhole).Column
Dim checkRange As Range
Set checkRange = .Range(.Cells(3, col), .Cells(50, col))
Dim sumRange As Range
Set sumRange = .Range("H3:H50")
Dim addEmUp As Double
addEmUp = WorksheetFunction.SumIf(checkRange, ">0", sumRange)
End With
ImporteLic = addEmUp
End Function
I am quite new to VBA and after lots of searching I haven't been able to find any help to the following problem.
I have a fairly large and complex table containing a lot of data. The data within the table has been conditional formatted to have different color fills. Using the following code, I am able to count the number of cells of a certain color within each range.
However I am looking to replace the range with for example something along the lines of; IF column C value matches "Apples" AND IF row 3 value matches "Farm A" THEN count green fills within this area.
The code I am using so far is below.
Dim rng As Range
Dim lColorCounter As Long
Dim rngCell As Range
Sheets("Matrix").Select
Set rng = Sheet1.Range("F140:O150")
For Each rngCell In rng
If Cells(rngCell.Row, rngCell.Column).DisplayFormat.Interior.Color = RGB(185, 255, 185) Then
lColorCounter = lColorCounter + 1
End If
Next
Sheets("Summary").Activate
Sheet3.Range("C4") = lColorCounter
lColorCounter = 0
Hope this makes sense and any help will really be appreciated. Thank you!
As discussed in comments, this has a dynamic row loop (check for value of Apples) and a dynamic column loop (check for color of cells).
The range of the 2nd loop is determined by the size of your merged cell ("Farm A") which starts in cell C2. So if you change your Farm A merged cell to span 20 columns, the loop will expand to those 20 columns.
Option Explicit
Sub test()
Dim i As Long, FarmA As Integer, MyCell As Range, lColorCounter As Long
Dim Matrix As Worksheet: Set Matrix = ThisWorkbook.Sheets("Matrix")
Application.ScreenUpdating = False
With Matrix
FarmA = .Range("C2").CurrentRegion.Count + 2 'Determine size of merged cell "FarmA"
For i = 3 To .Range("B" & .Rows.Count).End(xlUp).Row 'Loop through used rows in Col B
If .Range("B" & i) = "Apples" Then 'If condition is met, move to next line, else, check next row
For Each MyCell In .Range(.Cells(i, 3), .Cells(i, FarmA)) 'set serach range
If MyCell.DisplayFormat.Interior.Color = RGB(185, 255, 185) Then 'search for format
lColorCounter = lColorCounter + 1
End If
Next MyCell
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox lColorCounter
End Sub
I'm having a little trouble with finding the last row.
What I am trying to do is find the last row in column "A", then use that to find the last row within a range.
Example of Data:
1) LR_wbSelect = wbshtSelect.cells(Rows.count, "A").End(xlUp).Row - 22
2) LR_wbSelectNew = wbshtSelect.cells(LR_wbSelect, "A").End(xlUp).Row
I am using the last row in column "A" as the data from row 29 down will always be the same length, the rows used in column "B" from row 29 can be a varying number of rows.
So I am trying to use LR_wbSelect in column "A" to get my starting last Row, then within LR_wbSelectNew using it as the starting point to look up from.
This works when the column I set to "A", LR_wbSelectNew gives me the row of "17", but when I change the column in LR_wbSelectNew to "B" it doesn't give the correct last row of "18".
I can change the column to "C, D, E, F" and the code works fine, but the only column that I can use is "B" because it will always have data in it, where the rest of that row could have a blank cell.
After doing some testing on the sheet, by pressing CRTL & Up from the lastring point of LR_wbSelect column "B" ignores the data in the rows and go to the row where it find data. I can't see a reason why Excel doesn't think there is data in these cells?
There are mulitple results and methods when searching for the LastRow (in Column B).
When using Cells(.Rows.Count, "B").End(xlUp).Row you will get the last row with data in Column B (it ignores rows with spaces, and goes all the way down).
When using:
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
You are searching for the last row with data in Column B of the CurrentRegion, that starts from cell B10, untill the first line without data (it stops on the first row with empty row).
Full Code:
Sub GetLastRow()
Dim wbshtSelect As Worksheet
Dim LR_wbSelectNew As Long
' modify "Sheet2" to your sheet's name
Set wbshtSelect = Sheets("Sheet2")
' find last row with data in Column B
With wbshtSelect
LR_wbSelectNew = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
' for debug only
Debug.Print LR_wbSelectNew ' >>result 31
' find last row with data in Column B at current regioun starting at cell B10
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
' for debug only
Debug.Print LR_wbSelectNew ' >> result 18
End Sub
Edit1: code searches for last row for cells with values (it ignores blank cells with formulas inside).
Sub GetLastRow()
Dim wbshtSelect As Worksheet
Dim LR_wbSelectNew As Long
' modify "Sheet2" to your sheet's name
Set wbshtSelect = Sheets("Sheet2")
' find last row with data in Column B at current regioun starting at cell B10
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
Dim Rng As Range
Set Rng = wbshtSelect.Range("B10:B" & LR_wbSelectNew)
' find last row inside the range, ignore values inside formulas
LR_wbSelectNew = Rng.Find(What:="*", _
After:=Range("B10"), _
LookAt:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' for debug
Debug.Print LR_wbSelectNew ' << result 18 (with formulas in the range)
End Sub
Hope this piece of code helps !
Sub LastRowInOneColumn()
'Find the last used row in a Column: column A in this example
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
MsgBox LastRow
End Sub
I came here looking for a way to find the last row in a non-contiguous range. Most responses here only check one column at a time so I created a few different functions to solve this problem. I will admit, though, that my .Find() implementation is essentially the same as Shai Rado's answer.
Implementation 1 - Uses Range().Find() in reverse order
Function LastRowInRange_Find(ByVal rng As Range) As Long
'searches range from bottom up stopping when it finds anything (*)
Dim rngFind As Range
Set rngFind = rng.Find( What:="*", _
After:=rng.Parent.Cells(rng.row, rng.Column), _
LookAt:=xlWhole, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Not rngFind Is Nothing Then
LastRowInRange_Find = rngFind.row
Else
LastRowInRange_Find = rng.row
End If
End Function
Implementation 2 - Uses Range().End(xlUp) on each column
Function LastRowInRange_xlUp(ByVal rng As Range) As Long
Dim lastRowCurrent As Long
Dim lastRowBest As Long
'loop through columns in range
Dim i As Long
For i = rng.Column To rng.Column + rng.Columns.count - 1
If rng.Rows.count < Rows.count Then
lastRowCurrent = Cells(rng.row + rng.Rows.count, i).End(xlUp).row
Else
lastRowCurrent = Cells(rng.Rows.count, i).End(xlUp).row
End If
If lastRowCurrent > lastRowBest Then
lastRowBest = lastRowCurrent
End If
Next i
If lastRowBest < rng.row Then
LastRowInRange_xlUp = rng.row
Else
LastRowInRange_xlUp = lastRowBest
End If
End Function
Implementation 3 - Loops through an Array in reverse order
Function LastRowInRange_Array(ByVal rng As Range) As Long
'store range's data as an array
Dim rngValues As Variant
rngValues = rng.Value2
Dim lastRow As Long
Dim i As Long
Dim j As Long
'loop through range from left to right and from bottom upwards
For i = LBound(rngValues, 2) To UBound(rngValues, 2) 'columns
For j = UBound(rngValues, 1) To LBound(rngValues, 1) Step -1 'rows
'if cell is not empty
If Len(Trim(rngValues(j, i))) > 0 Then
If j > lastRow Then lastRow = j
Exit For
End If
Next j
Next i
If lastRow = 0 Then
LastRowInRange_Array = rng.row
Else
LastRowInRange_Array = lastRow + rng.row - 1
End If
End Function
I have not tested which of these implementations works fastest on large sets of data, but I would imagine that the winner would be _Array since it is not looping through each cell on the sheet individually but instead loops through the data stored in memory. However, I have included all 3 for variety :)
How to use
To use these functions, you drop them into your code sheet/module, specify a range as their parameter, and then they will return the "lowest" filled row within that range.
Here's how you can use any of them to solve the initial problem that was asked:
Sub answer()
Dim testRange As Range
Set testRange = Range("A1:F28")
MsgBox LastRowInRange_Find(testRange)
MsgBox LastRowInRange_xlUp(testRange)
MsgBox LastRowInRange_Array(testRange)
End Sub
Each of these will return 18.
If your wbshtSelect is defined as worksheet and you have used set to define the specific worksheet, you can use this.
Dim LastRow As Long
wbshtSelect.UsedRange ' Refresh UsedRange
LastRow = wbshtSelect.UsedRange.Rows(wbshtSelect.UsedRange.Rows.Count).Row
Otherwise take a look here http://www.ozgrid.com/VBA/ExcelRanges.htm
LR_wbSelectNew = wbshtSelect.cells(LR_wbSelect, "B").End(xlUp).Row
Why are you using "LR_wbSelect" as the row counter? If you want to know the last row of column 'B', you should use Rows.count
Rows.count --> Returns maximum number of rows (which is 1048576 for Excel 2007 and up)
End(xlUp) --> Moves the pointer upward to the last used row
So,
cells(Rows.count, "A").End(xlUp).Row --> This moves the pointer to the last row if the column 'A' (as if you are pressing Crtl+Up keys when A1048576 cell is selected)
So, use Rows.count to select the last row for column 'B' as well. If you have some specific requirement related to LR_wbSelect, please mention it.
Alternatively, if you want to know the last row used in a sheet, you may use the below:
mySheet.Cells.SpecialCells(xlCellTypeLastCell).Row
LR_wbSelect = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Simple function that return last row no. in specific sheet.
It takes the last address in UsedRange and retrieve last row number.
Feel to free change the code and use standard range insead of UsedRange.
Function FindLastRow(wsToCheck As Worksheet) As Long
Dim str As String
str = wsToCheck.UsedRange.AddressLocal()
FindLastRow = Right(str, InStr(1, StrReverse(str), "$") - 1)
End Function
Range().End will bring you to the end of a code block. If the starting cell is empty, it brings you the the first used cell or the last cell. It the cells is not empty it brings you to the last used cell. For this reason, you need to test whether or not the cell in column B is to determine whether to use LR_wbSelectNew as the last row.
With wbshtSelect
LR_wbSelect = .Cells(Rows.Count, "A").End(xlUp).Row - 22
If .Cells(LR_wbSelect, "B") <> "" Then
LR_wbSelectNew = LR_wbSelect
Else
LR_wbSelectNew = .Cells(LR_wbSelect, "B").End(xlUp).Row
End If
End With
This code defines a Target range that extends from A1 to the last row in column a - 22 and extends 10 columns.
Dim Target As Range
With wbshtSelect
Set Target = .Range("A1", .Cells(Rows.Count, "A").End(xlUp).Offset(-22)).Resize(, 10)
End With
'This is sure method to find or catch last row in any column even 'if some cell are blank in-between. (Excel-2007)`
'This works even if sheet is not active
'mycol is the column you want to get last row number
for n=1048575 to 1 step -1
myval=cells(n,mycol)
if myval<>"" then
mylastrow=n 'this is last row in the column
exit for
end if
next
ret=msgbox("Last row in column-" & mycol & "is=" & mylastrow)
Dim rng As Range
Dim FirstRow, LastRow As long
Set rng = Selection
With rng
FirstRow = ActiveCell.Row
LastRow = .Rows(.Rows.Count).Row
End With
Shai Rado's first solution is a great one, but for some it might need a bit more elaboration:
Dim rngCurr, lastRow
rngCurr = wbshtSelect.Range("B10").CurrentRegion
lastRow = rngCurr.Rows(rngCurr.Rows.Count).Row
If you want to know the last used row in the entire worksheet:
Dim rngCurr, lastRow
rngCurr = Range("A1").CurrentRegion
lastRow = rngCurr.Rows(rngCurr.Rows.Count).Row
Backing off from the range to the worksheet will get you the whole sheet extents of the range used on the sheet (which may be smaller than you expect if the sheet doesn't have data in the top rows; but it does include internal blanks)
TheRange.Worksheet.UsedRange.Rows.Count
If there is no data in the top rows, the following will get you the first row which you need to add to the above to get the highest row number
TheRange.End(xlDown).Row
So
Dim TheRange as Range
Dim MaxRow as Long
MaxRow = TheRange.Worksheet.UsedRange.Rows.Count + TheRange.End(xlDown).Row
Will get the highest row number with data (but not the whole sheet)
Before getting into complex coding why not build something on the below principle:
MaxRow = Application.Evaluate("MIN(ROW(A10:C29)) + ROWS(A10:C29) - 1")
I have a named range set up on a sheet. It is called ProjData.
My VB code can insert a new row alphabetically ok.
Where I am stuck is adding the new row at the top of the named range or at the bottom of the named range.
I have tried many iterations on the range.insert, but I cannot add the rows at the top or the bottom. The row always inserts on the sheet row before or after the named range.
Here is my code.
Public Sub test()
Dim rng As Range
Dim aNumber As Variant
Dim rowNum As Variant
Dim iRows As Integer
aNumber = "Orange"
Set rng = Worksheets("Overview").Range("ProjData")
iRows = rng.Rows.Count
If iRows = 1 And rng(1, 1).Value = "" Then
'rng.Rows(rowNum).Insert shift:=xlDown
'rng.Rows(rowNum).Copy rng.Rows(rowNum + 1)
rng(1, 1).Value = aNumber
For x = 2 To 19
rng(1, x).Formula = "=now()"
Next x
Exit Sub
End If
rowNum = Application.Match(aNumber, rng.Columns(1), 1)
If Not IsError(rowNum) Then
rng.Rows(rowNum + 1).Insert shift:=xlDown
rng.Rows(rowNum).Copy rng.Rows(rowNum + 1)
rng(rowNum + 1, 1).Value = aNumber
Else
rng.Rows(1).Insert shift:=xlDown
rng.Rows(2).Copy rng.Rows(1)
rng(1, 1).Value = aNumber
End If
End Sub
Thanks,
Rich
This code will add a new Row before the specified row of a Named Range, and then Resize the Named Range to include the newly inserted row
(e.g. if your Named Range is $A$4:$B$17, then $A$4:$B$4 is Row 1, and $A$17:$B$17 is Row 14, or Row 15 to add a Row to the End of the Named Range)
Public Function NamedRange_AddRow(Target As Name, InsertAt As Long) As Boolean
'Target: Named Range to insert Row to.
'InsertAt: Row of the Named Range to insert the Row before;
' If this is 1 larger than the count of Rows, the new row will be added to the end
NamedRange_AddRow = False
On Error GoTo ExitFunction
Dim InsertRange As Range, CurrentRows As Long
CurrentRows = Target.RefersToRange.Rows.Count
If (InsertAt < 1) Or (InsertAt > (CurrentRows + 1)) Then Exit Function
Target.RefersToRange.Rows(InsertAt).Offset(IIf(InsertAt > CurrentRows, 1, 0), 0).Insert xlShiftDown
Target.RefersTo = Target.RefersToRange.Offset(IIf(InsertAt = 1, -1, 0), 0).Resize(CurrentRows + 1)
NamedRange_AddRow = True
ExitFunction:
End Function
I've just had to solve a similar problem myself. Like you I found that inserting a new row between two existing rows in the range worked fine, but inserting the row above the first row of the range and inserting the row below the bottom row of the range didn't change the size of the range to include them.
Based on a relevant answer on the MrExcel.com forums, in order to include the new row in the range it appears that you need to:
Create a copy of the original range
Resize the new range, using it's
Offset and Resize methods, to include the new row
Assign the original
range's name to the new range
I've written two functions based on this logic to add rows to the start or the end of a range. Please read through the comments for how I've applied the logic and I hope the code is of use.
Function InsertRowAtStartOfNamedRange(sheet As Worksheet, rangeName As String) As Integer
Dim firstRowOfRange As Range, newRow As Range, workingRange As Range
With sheet.Range(rangeName)
' Get the first row of the named range.
Set firstRowOfRange = .Rows(1).EntireRow
' Insert the new row above the first row of the named range.
firstRowOfRange.Insert xlShiftDown
' Set the new row range so we can return the row number from this function.
Set newRow = firstRowOfRange.Offset(rowOffset:=-1)
' Assign a copy of the offset and resized range to workingRange.
Set workingRange = .Offset(rowOffset:=-1)
Set workingRange = workingRange.Resize(rowSize:=.Rows.Count + 1)
End With
' Change the named range to use workingRange's resized range by assigning the range name.
workingRange.Name = rangeName
' Return the row number from the function.
InsertRowAtStartOfNamedRange = newRow.Row
End Function
Function InsertRowAtEndOfNamedRange(sheet As Worksheet, rangeName As String) As Integer
Dim lastRowOfRange As Range, newRow As Range, workingRange As Range
With sheet.Range(rangeName)
' Get the last row of the named range.
Set lastRowOfRange = .Rows(rowIndex:=.Rows.Count).EntireRow
' Insert the new row from the row below the last row of the named range.
lastRowOfRange.Offset(rowOffset:=1).Insert xlShiftDown
' Set the new row range so we can return the row number from this function.
Set newRow = lastRowOfRange.Offset(rowOffset:=1)
' Assign a copy of the resized range to workingRange.
Set workingRange = .Resize(rowSize:=.Rows.Count + 1)
End With
' Change the named range to use workingRange's resized range by assigning the range name.
workingRange.Name = rangeName
' Return the row number from the function.
InsertRowAtEndOfNamedRange = newRow.Row
End Function