Cross-reference in table - excel

I'm begginer in VBA and looking for a solution to check something in a table. I would like to create a function that tells if cells in a certain column (range) is not empty only then if the cell in the title column (range) equals something. I tried with a combination of isempty and vlookup but it didn't work.
I hope the description is clear, anyway I attached a simplified table with the problem. Thank you in advance!
enter image description here

Not sure i have understood your problem 100% but lets begin with what i think i understood, and start with the below:
Sub isitEmpty()
With Sheets("Sheet1")
If IsEmpty(.Range("B1:E2")).Value Then
'do something
Else
'do something
End If
End With
End Sub
What do you want to do if the cell is/isnot empty?

Below code works with following assumptions:
Project Type are listed in Column A starting from Cell A4
A,B,C,D category could vary but will always have headings in Row 3
Project Type for which you want the participation as Y, are listed in a column that appear after the last column with headings A,B,C,D. So as per your image its Column F
Sub Demo()
Dim ws As Worksheet
Dim lRProject As Long, lRMatch As Long, lastColumn As Long, i As Long
Dim rngProject As Range, celPro As Range, rngMatch As Range, celMatch As Range
Set ws = ThisWorkbook.Sheets("Sheet5") 'change to your sheet
With ws
lastColumn = .Cells(3, Columns.count).End(xlToLeft).Column 'gives last column with A,B,C,D
lRProject = .Cells(.Rows.count, "A").End(xlUp).Row 'last row in Column A
lRMatch = .Cells(.Rows.count, lastColumn + 1).End(xlUp).Row 'last row in Column F
Set rngMatch = .Range(.Cells(1, lastColumn + 1), .Cells(lRMatch, lastColumn + 1))
Set rngProject = .Range("A4:A" & lRProject)
For Each celMatch In rngMatch
For Each celPro In rngProject
For i = 2 To lastColumn
If celPro.Value = celMatch Then
If .Cells(celPro.Row, i) = "X" Then
.Cells(celMatch.Row, i) = "Y"
End If
End If
Next i
Next celPro
Next celMatch
End With
End Sub
See image for reference.

Related

Find matching value on another sheet and paste into next empty cell on that row

I've been struggling with this all day and I'm sure there's a really simple answer that I'm just not finding so hoping someone can point me in the right direction!
What I want to achieve is:
see if a value (R.BName) from sheet1 (wsResults) can be found in column c of sheet2 (wsSchedule);
if found, paste a value from sheet1 (that I've already copied) into
the next empty cell of that row;
if not found, insert a value into a specific cell in sheet1
The 2 issues I'm having are that:
If there is a match - the paste location is the last cell in row1 - yes, I know that this be because my code has (1,columns.count) but I don't know how to get it to select the cell of the match!
"broker name not found on review schedule" is being added to wsResults even if a match was on wsSchedule
Here is my defective code:
'copy result from wsresults
wsResults.range("R.Result").Copy
'find broker & add result to review schedule sheet
Dim wsSchedule As Worksheet
Dim rSearch As range
Dim c As range
Set wsSchedule = Worksheets("Review Schedule")
Set rSearch = wsSchedule.range("C5:C400")
For Each c In rSearch
If c.Value = wsResults.range("R.BName").Value Then
wsSchedule.Cells(1, Columns.count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
Else
With wsResults
.range("AP2:AP2").Value = "Broker name not found on review schedule"
End With
End If
Next c
Any assistance that can be offered would be greatly appreciated!
I believe this is what you had in mind. Please try it.
Sub Test()
' 009
Dim wsSchedule As Worksheet
Dim wsResults As Worksheet
Dim searchCrit As Variant
Dim lastR As Long
Dim R As Long
Set wsSchedule = Worksheets("Review Schedule")
Set wsResults = Worksheets("Results")
' try to access sheet values as little as possible: it's slow
' here, once is enough. No need to do it on every loop
searchCrit = wsResults.Range("R.BName").Value
With wsSchedule
lastR = .Cells(.Rows.Count, "C").End(xlUp).Row
For R = 5 To lastR
If .Cells(R, "c").Value = searchCrit Then
.Cells(R, Columns.Count).End(xlToLeft).Offset(0, 1) = wsResults.Range("R.Result")
Exit For
End If
Next R
End With
' R will be <=lastR if a match was found
If R > lastR Then
wsResults.Cells(2, "AP").Value = "Broker name not found on review schedule"
End If
End Sub
However, #SJR is right: using Find in place of the loop would be more efficient.

VBA Add rows based on how many times a criteria is met

I am quite new to VBA so my question may sound silly to some of you.
I have a problem with my code. I am trying to check between 2 sheets(1st: test and 2nd: test data. In the code I am using the code name of the sheets) how may times a criteria/my product is met and based on that number to add that many rows beneath the SKU/product.
What I want to do is, if for my first product/SKU I have stock in 5 different locations, I want to add 5 rows in the first sheet and to see the qty in column D and the location in column E.
TestData tab
The reason why I need to list the quantity in different cells is that the stock is in different locations, so I can not just add in to one cell.
I am also adding screen shots of how my two sheets look like.
I have not add the loop to find the location yet, but I want to understand how to add the rows first.
Sub test()
Dim myrange As Range, testrange As Range, cell As Range, result As Range
Dim i As Long, testlastrow As Long, lastrow As Long
Dim helprng As Range
lastrow = TESTTAB.Range("a" & Rows.Count).End(xlUp).row
testlastrow = TDATA.Range("a" & Rows.Count).End(xlUp).row
Set testrange = TDATA.Range("a2:c" & testlastrow)
Set myrange = TESTTAB.Range("b2:b" & lastrow)
Set result = TESTTAB.Range("d2:e" & testlastrow)
Set helprng = TESTTAB.Range("f2:f" & lastrow)
For Each cell In myrange
For i = 1 To lastrow
If cell.Cells(i, 1) = testrange.Cells(i, 1) Then
result.Cells(i, 1) = testrange.Cells(i, 2)
End If
Next i
Next cell
End Sub
Here is the raw structure you were asking for.
Sub test()
' 011
Dim Rng As Range
Dim Tmp As Variant
Dim Radd As Long ' number of rows to add
Dim R As Long ' row counter
With Tdata
' Range, Cells and Rows Count, all in the same sheet
' exclude caption row(s)
Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
Application.ScreenUpdating = False ' speed up the process
With TestTab
' end the loop in row 2 because row 1 might contain captions
' loop bottom to top because row numbers will change
' below the current row as you insert rwos
' column 1 = "A"
For R = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
Tmp = .Cells(R, 1).Value
Radd = Application.CountIf(Rng, Tmp)
If Radd > 1 Then
.Range(.Rows(R + 1), .Rows(R + Radd)).Insert
.Cells(R + 1, 1).Value = Radd ' for testing purposes
End If
Next R
End With
Application.ScreenUpdating = True ' now you look
End Sub
As our Evil Blue Monkey has suggested, inserting blank rows and then populating them may not be the most efficient way. You can copy a row and then click Insert to insert the copied data into a new row. Get the syntax from the Macro recorder if it's of interest. It works with the Range object the same way.

Find last row in range

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")

Delete rows within range according to values in a column

I need to create a macro that would look at every cells only in a specific column (i.e. not the whole spreadsheet) and starting at a specific row. Then, it would have all rows that does not contain my value of interests.
Lets say for example my goal is to search every value in column "A" and I'll filter from A2 to A99999999, leaving A1 untouched.I would then delete every row that does not contain 103526 and 103527 in column A.
The following code is able to filter through all the rows for my values of interest, however, I am having trouble filtering only ONE column and from A2 to A99999999. How can I change this code to meet those conditions?
Sub test()
Dim j As Integer, k As Integer
Dim r As Range, cfind6 As Range, cfind7 As Range
Worksheets("sheet1").Activate
On Error Resume Next
j = Cells(Rows.Count, "A").End(xlUp).Row
For k = j To 1 Step -1
Set cfind6 = Rows(k).Cells.Find(what:=103526, lookat:=xlWhole)
Set cfind7 = Rows(k).Cells.Find(what:=103527, lookat:=xlWhole)
If cfind6 Is Nothing And cfind7 Is Nothing Then Rows(k).Delete
Next
There are a couple of different ways to approach this, one way would be to change your code to something like:
Sub test()
Dim i As Integer
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Not (ws.Cells(i, 1).Value = 103526 Or ws.Cells(i, 1).Value = 103527) Then
ws.Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub

Need the last row number which contain comment

I'm trying to clear an entire row of cells containing a comment. So I want the last active row number which contains the comment.
I've used
LastRow = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "B").End(xlUp).Row
but this is returning the last row number which contains the value.If my cell has only comment but no value then it's not giving the last row number.
Any alternative suggestion for clearing the cell comments for entire column will also welcome.
Thanks in advance.
My code to clear value is as below. I want to clear the comments as well.
Sub columnClear()
Dim LastRow As Long
Dim i As Long
LastRow = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "B").End(xlUp).Row
For i = 3 To LastRow
Worksheets("Sheet1").Cells(i, 2).Value = Empty
Next
End Sub
Try this:
LastRow = Worksheets("Sheet1").Comments(Worksheets("Sheet1").Comments.Count).Parent.Row
This is for last comment in whole sheet but I hope will be ok.
You don't have to clear either contents or comments individually in a loop:
Dim ws1 As Worksheet
Set ws1 = Worksheets("Sheet1")
With ws1
ws1.Range(.Cells(3, 2), .Cells(lastRow, 2)).Clear
'clears content, comments and formatting
'or .ClearContents, .ClearComments
End With
You can also obtain a Range reference for all the comments within a range:
Set rngComments = Range("B:B").SpecialCells(xlCellTypeComments)
There may be a way to extract the last comment's row from this, otherwise you could loop through this range to find the max row-number.
Dim rngComments As Range
Dim rng As Range
Dim lLastComment As Long
Set rngComments = Range("B:B").SpecialCells(xlCellTypeComments)
For Each rng In rngComments
If rng.Row > lLastComment Then
lLastComment = rng.Row
End If
Next rng
MsgBox "Last comment row for B is " & lLastComment

Resources