Looking for cells which contain certain value in another sheet - excel

I have two sheets where Sheet 1 has three vendor number in column A and Sheet 2 has a list of account names in column B.
I would like to search in Sheet 1 column A all cells where the value contains the cell value in Sheet 2 column C. For example, if the cells from C2:C5 contain one of the value between A2:A4, Sheet 2 cells from E2:E5 will show "Yes" else showing nothing.
Below are my codes, but I keep getting an error message:
"Invalid Next control variable reference".
Set sh1 = Worksheets("Vendor")
Set sh2 = Worksheets("Invoice")
Set r1 = sh1.Range("A2:A4")
Set sh1 = Worksheets("Vendor")
Set sh2 = Worksheets("Invoice")
Set r1 = sh1.Range("A2:A4")
Set r2 = sh2.Range("E2:E5")
For Each vendorCell In r2
If cell = vendorCell Then
cell = "Yes"
Else
cell = "out of range"
Exit For
End If
Next cell

I would like to search in Sheet 1 column A all cells where the value contains the cell value in Sheet 2 column C. For example, if the cell from 'C2' to 'C5'contains one of the value between "A2" and "A4", sheet 2 cell from 'E2' to 'E5' will show "Yes" else showing nothing.
Your loop says For Each vendorCell In r2 but then you are closing it with Next cell and hence you are getting that error. It should be Next vendorCell.
Having said that, I think this is what you are trying to achieve?
Option Explicit
Sub Sample()
Dim sh1 As Worksheet: Set sh1 = Worksheets("Vendor")
Dim sh2 As Worksheet: Set sh2 = Worksheets("Invoice")
Dim r1 As Range: Set r1 = sh1.Range("A2:A4")
Dim r2 As Range: Set r2 = sh2.Range("C2:C5")
Dim aCell As Range, bCell As Range
'~~> Loop through col C
For Each aCell In r2
aCell.Offset(, 2).Value = "out of range"
'~~> Loop through column A
For Each bCell In r1
If aCell.Value2 = bCell.Value2 Then
'~~> Write to column E
aCell.Offset(, 2).Value = "Yes"
Exit For
End If
Next bCell
Next aCell
End Sub
Note:
This is a very small range so using For Next is ok. Otherwise I would have recommended using .Find
BTW you do nto need VBA for this. You can achieve this using formulas as well :)

Related

How to run an For Loop where if cell is true (has text), the row is copied to a different ss

So i want to make a loop where it checks the data in every cell in a column and if the cell has any type of data, it copy's the entire row to a different ss. If the cell is blank i need it to move onto the next cell below and not copy the row.
I have added some code below, im trying to copy all the rows in report1 in column H:H that have any input to Report3.
Sub GenerateReport3_Click()
Dim rep1 As Worksheet
Dim rep3 As Worksheet
Set rep1 = ThisWorkbook.Worksheets("Report1")
Set rep3 = ThisWorkbook.Worksheets("Report3")
Dim rngA As Range
Dim cell As Range
rep1.Range("A1:J1").Copy Destination:=rep3.Range("A1")
Set rngA = Sheets("Report1").Range("H:H")
For Each cell In rngA
If cell.Value = True Then
cell.EntireRow.Copy Destination:=rep2.Range("A" & Rows.Count).End(xlUp)(2)
End If
Next cell
End Sub
Every row in column in report 1 H:H that has any input needs to be copied to Report3.
Test for Not IsEmpty(...) rather than =TRUE.
Also, a few details around geting Range references need work (eg avoiding implicit references to ActiveSheet).
And don't loop over the entire 1,000,000+ rows in a column (That's so slow!)
Something like this
Sub GenerateReport3_Click()
Dim rep1 As Worksheet
Dim rep3 As Worksheet
Set rep1 = ThisWorkbook.Worksheets("Report1")
Set rep3 = ThisWorkbook.Worksheets("Report3")
Dim rngA As Range
Dim cell As Range
rep1.Range("A1:J1").Copy Destination:=rep3.Cells(1, 1)
With rep1
Set rngA = .Range(.Cells(1, "H"), .Cells(.Rows.Count, "H").End(xlUp))
For Each cell In rngA
If Not IsEmpty(cell) Then
cell.EntireRow.Copy Destination:=rep3.Cells(rep3.Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next cell
End With
End Sub
Note that if this is still too slow, there a are more ways to speed it up

VBA Excel Look for values between 2 dynamic ranges

For each cell in 'myRange' I want to check for a range of values in Sheet2 and if the values in Sheet2 are found in myRange then for the corresponding row I want to put the value from Column A into Column E
As it stands, I'm only able to look for a single value from Sheet2 ("A1"). When attempting to extend this range I get errors.
Is there a way to make the range in Sheet2 dynamic, please?
Sub Find_values()
Dim myRange As Range
Dim Cell As Range
Dim LR As Long
LR = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
Set myRange = Sheets(1).Range("B1:B" & LR)
For Each Cell In myRange
If Cell.Value = Sheets(2).Range("A1").Value Then Cell.Offset(0, 3) = Cell.Offset(0, -1).Value
Next Cell
End Sub
As others suggested, you can simply nest two For Each loops.
Sub Find_values()
Dim myRange1 As Range
Dim myRange2 As Range
Dim Cell1 As Range
Dim Cell2 as Range
Set myRange1 = Sheets(1).Range(range("B1"),range("B1").end(xlDown))
Set myRange2 = Sheets(2).Range(range("A1"),range("A1").end(xlDown)) 'This range is also dynamic and will adapt to teh number of entries you ahve in Sheet2
For Each Cell1 In myRange1
For Each Cell2 In myRange2
If Cell1.Value2 = Cell2.Value2 Then
Cell1.Offset(0, 3) = Cell1.Offset(0, -1).Value2
Exit for 'Save you some useless processing time since the entry has already been found
end If
Next Cell2
Next Cell1
End Sub
Note I have re-wrote your Range statment to be more cleaner.
Note I have also changed your .value statement into .value2, which depending on the type of data used in your cell will in some cases work better.
Follow this steps:
Convert the data in Sheet1 to an structured Excel table:
1- Select the range from scale's cell to the concatenate last cell
2- Click on the Ribbon "Home" | "Styles" | "Format as table" |
3- Check "My table has headers" box (mark it)
4- Write down the name of the table (While selecting one cell inside the table, look in the "Table tools" ribbon | "Table name"
5- Repeat the previous steps for the data in Sheet2
6- Add the following code to a VBA module:
Sub LookupValues()
' Define object variables
Dim sourceSheet As Worksheet
Dim sourceTable As ListObject
Dim sourceCell As Range
Dim dataSheet As Worksheet
Dim dataTable As ListObject
' Define other variables
Dim sourceSheetName As String
Dim sourceTableName As String
Dim dataSheetName As String
Dim dataTableName As String
' >>>>Customize this<<<<<
sourceSheetName = "Sheet2"
sourceTableName = "Table2"
dataSheetName = "Sheet1"
dataTableName = "Table1"
' Initialize worksheets
Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName)
Set dataSheet = ThisWorkbook.Worksheets(dataSheetName)
' Initialize source table
Set sourceTable = sourceSheet.ListObjects(sourceTableName)
Set dataTable = dataSheet.ListObjects(dataTableName)
' Loop through every cell in sourceSheet
For Each sourceCell In sourceTable.DataBodyRange.Columns(1).Cells
' >>>>Customize this<<<<<
' In the following code:
' Offset(0, 4) -> 4 stand for 4 columns after column A
' Index(dataTable.DataBodyRange.Columns(1) -> 1 stands to return the first column of the data table
' Match(sourceCell.Value, dataTable.DataBodyRange.Columns(2) -> 2 stands to look in the second column of the data table
If Not IsError(Application.Match(sourceCell.Value, dataTable.DataBodyRange.Columns(2), 0)) Then
sourceCell.Offset(0, 4).Value = Application.Index(dataTable.DataBodyRange.Columns(1), Application.Match(sourceCell.Value, dataTable.DataBodyRange.Columns(2), 0))
End If
Next sourceCell
End Sub
6- Customize the code to fit your needs
7- Test it and let us know if it works
Hope it helps!

Getting row number of a cell in respect to a specified range

I am trying to get the row number of a cell in a range that I specify with vba. I want to get the row number of the cell in the range but what I am getting is the row number of the cell in the worksheet.
This is the vba code I am using currently. I have set a range and within the range I search for a cell that contains the text string "C". Once I have found the cell I want to make changes to the value in the second column of the range.
Sub trial2()
Dim ActiveWB As Workbook
Dim ActiveWS As Worksheet
Dim rng As Range, findCell As Range
Set ActiveWB = ActiveWorkbook
Set ActiveWS = ActiveWB.ActiveSheet
Set rng = ActiveWS.Range("B4", "C10")
With rng
Set findCell = .Cells.Find(what:="C")
End With
rng.Cells(findCell.Row, 2).Value = "change to something."
End Sub
Before running the code:
After running the code:
the cell value that contains "C" is in the 6th row of the worksheet, but in the 3rd row of the range. I was wondering how do I get the 3rd row of the range. I am aware that I can just offset the cell by 1 column to solve this problem, but I am curious about getting row numbers of cells in respect to a defined range.
One option is to adjust based on the number of the first row of rng, using simple math.
rng.Cells(findCell.Row - rng.Row + 1, 2).Value = "change to something."
In this case 6 - 4 + 1 = 3.
You can use:
Option Explicit
Sub test()
Dim rng As Range
With ThisWorkbook.Worksheets("Sheet1")
'If your searching area for A,B,C etc is from B4 to B10 just use
Set rng = .Range("B4:B10").Cells.Find(what:="C")
'If your searching area for A,B,C etc is from B4 to C10 just use
Set rng = .Range("B4:C10").Cells.Find(what:="C")
If Not rng Is Nothing Then
'Way 1
.Cells(rng.Row, rng.Column + 1).Value = "change to something."
'Way 2
rng.Offset(0, 1).Value = "change to something."
Else
MsgBox "No ""C"" found."
End If
End With
End Sub

Select a specific number of rows (below the header row) based on value in another cell

I'd like to select a specific number of cells in Sheet3 based on the count available in cell Z1 in Sheet2. The below code is somewhat of help, but not completely. The data in Sheet3 is a filtered range and I'd like to select only the visible cells (based on the count provided in Z1) below the header column in Sheet 3. Thanks in advance!
Sheets("Sheet3").Range("A1:X" & Sheets("Sheet2").Range("Z1").Value).Select
I assumed your headers take one row. Change HeaderRows accordingly.Private
Sub Test()
Dim myRange As Range, HeaderRows As Long
Dim newRange As Range, myArea As Range
Set myRange = Sheets("Sheet3").Range("A1:X" & Sheets("Sheet2").Range("Z1").Value)
'Change number of rows accordingly
HeaderRows = 1
With myRange
Set myRange = .Offset(HeaderRows, 0).Resize(.Rows.Count - HeaderRows, _
.Columns.Count).SpecialCells(xlCellTypeVisible)
End With
'Loop through each visible area
Set newRange = myRange.Areas(1)
For Each myArea In myRange.Areas
'Add area to a range
Set newRange = Application.Union(myArea, newRange)
Next
'Select new range
newRange.Select
End Sub

Use a range of cell values for multiple worksheet names

I have a range of cell numbers that I need for multiple worksheet names.
I create multiple worksheets based on the number of rows.
Sub Copier()
Dim x As Integer
x = InputBox("Enter number of times to copy worksheet")
For numtimes = 1 To x
ActiveWorkbook.Sheets("OMRS 207").Copy _
After:=ActiveWorkbook.Sheets("OMRS 207")
Next
End Sub
That grabs only one name, OMRS 207.
I want to generate these worksheets using the entire range of cells in the original worksheet.
Try below code.
Dim data As Worksheet
Dim rng As Range
Set data = ThisWorkbook.Sheets("Sheet1")
Set rng = data.Range("A2")
Do While rng <> ""
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = rng.Value
Set rng = rng.Offset(1, 0)
Loop
I assumed that your data starts from 2nd row in Sheet1 and you want the sheet name as per values in Column A.
If you want row number as sheet name for newly added sheet just use rng.row while assigning name to sheet.

Resources