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
Related
I have a long list of equipment like this;
I would like to be able to run a VBA script that allows excel to change the format of the first of a series so that they are more visible. Is this a possibility?
This is housed in an excel table, not sure if that has an impact.
You could iterate through the range update format if below cell<>previous cell.
Sub UpdateCatHead(ByRef rng As Range, Optional col_index As Integer = 1)
Dim rng_search As Range
'lets ,make sure to have range of one column
Set rng_search = rng.Columns(col_index)
Dim cell As Range, prev_cell As Range
Dim prev_cat As String
For Each cell In rng_search.Cells
'check if empty is empty and exit for?
If cell.Row = 1 Then
'update cell to bold here
Debug.Print (cell.Row)
Else
Set prev_cell = cell.Worksheet.Cells(cell.Row - 1, cell.Column) 'cell above
If CStr(cell.Value) <> CStr(prev_cell.Value) Then
'update cell to bold here
Debug.Print (cell.Row)
End If
End If
Next cell
End Sub
call Sub like this:
UpdateCatHead ThisWorkbook.Sheets("data").Range("A1:A100")
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 :)
I am trying to highlight a cell if it doesn't equal the value defined in a worksheet range.
I am checking each cell in the range "ADS_Export[ADS_208_SZ]" against Worksheets(ADS_Validator").Range("E3:E500") but it doesn't like the range E3:E500.
Seems to work if I just put E3 but all after the first cell check are incorrect as its checking against the third row, not the next row in the worksheet range (E4 etc.).
It needs to check the first value in the ADS_Export range against the first value in the worksheet range which starts at E3 and then does the next one. Also, need to redefine to highlight if not equal instead of equal.
Only just getting into VBA so my knowledge is very limited.
Sub IF_Loop()
Dim cell As Range
For Each cell In Range("ADS_Export[ADS_208_SZ]")
If cell.Value = Worksheets("ADS_Validator").Range("E:E").Value Then
cell.Interior.Color = 65535
End If
Next cell
End Sub
Try this code, please:
Sub IF_Loop()
Dim cell As Range, celVal As Range, lastRow As Long
lastRow = Worksheets("ADS_Validator").Range("E" & Rows.Count).End(XlUp).row
For Each cell In Range("ADS_Export[ADS_208_SZ]")
For Each cellval In Worksheets("ADS_Validator").Range("E3:E" & lastRow)
If cel.value = celVal.value Then
cell.Interior.Color = 65535
End If
Next
Next cell
End Sub
I want to look through a table in a sheet. Find each cell with "Yes" in it, when one is found. Paste a Yes to A1, when another is found A2, etc...
I was trying to modify this code to search all cells instead of just Row A
Following code should give you the headstart
Sub Text_search()
Dim Myrange As Range
Set Myrange = ActiveSheet.UsedRange
For Each cell In Myrange
If InStr(1, cell.Value, "YES") > 0 Then
'do something
Else
'do something else
End If
Next
End Sub
Further to #isomericharsh's answer, if it's a table you're looking through, that simplifies defining the range; just use DataBodyRange.
If the table 'Table1' is on 'Sheet1' and the results are to be posted on 'Sheet2' then I'd do as follows:
Sub Search_for_Yes()
Dim YesAmt As Long ' - Amount of yes's found
YesAmt = 0 'to start with
Dim ws1 As Worksheet
Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet
Set ws2 = Sheets("Sheet2")
'It's always safer to use specific references rather than ActiveSheet
For Each cell In ws1.ListObjects("Table1").DataBodyRange 'The data in the table excluding headings and totals
If cell.Value = "YES" Then 'might need to add wildcards to this if you want to include cells that contain yes as part of larger text string. Also note that it's case-specific.
ws2.Cells(1 + YesAmt, 1).Value = "Yes" 'so that each time a yes is found it will log it further down
YesAmt = YesAmt + 1
End If
Next
x = MsgBox(YesAmt & " values found and listed", vbOKOnly + vbInformation)
End Sub
Does that help?
I have values on Sheet 1 and I gave the background color using conditional formatting.
I want to copy only the color and paste it to the corresponding cell of sheet 2 without pasting the value.
Example if sheet 1 cell A1 has red color for specific value, transfer the color to sheet 2 A1.
I use two colors, red and white. Red is for higher value and white is for lower value.
Sub copycolor()
Dim intRow As Integer
Dim rngCopy As Range
Dim rngPaste As Range
For intRow = 1 To 20
Set rngCopy = Sheet1.Range("A" & intRow + 0)
Set rngPaste = Sheet2.Range("b" & intRow)
'Test to see if rows 500+ have a value
If rngCopy.Value <> "" Then
'Since it has a value, copy the value and color
rngPaste.Value = rngCopy.Value
rngPaste.Interior.Color = rngCopy.Interior.Color
End If
Next intRow
End Sub
rngPaste.Interior.Color = rngCopy.DisplayFormat.Interior.Color
Seems to work for me. Keep in mind that DisplayFormat is read-only and is not allowed to return value outside of the function it's used in. Also it is only available in Excel 2010 +
I was editing my answer to include the other stuff you mentioned and realized it was getting confusing to explain it all in separate chunks. Here's a recommended approach to achieve what you're saying.
Public Sub CopyColor()
Dim SourceSht As Worksheet
Dim TargetSht As Worksheet
Dim rngCopy As Range
Dim rngPaste As Range
Dim LastCopyRow As Long
Dim LastCopyColumn As Long
'Define what our source sheet and target sheet are
Set SourceSht = ThisWorkbook.Worksheets("Sheet1")
Set TargetSht = ThisWorkbook.Worksheets("Sheet2")
'Find our used space on the source sheet
LastCopyRow = SourceSht.Cells(Rows.Count, "A").End(xlUp).Row
LastCopyColumn = SourceSht.Cells(1, Columns.Count).End(xlToLeft).Column
'Setup our ranges so we can be sure we don't loop through unused space
Set rngCopy = SourceSht.Range("A1:" & SourceSht.Cells(LastCopyRow, LastCopyColumn).Address)
Set rngPaste = TargetSht.Range("A1:" & TargetSht.Cells(LastCopyRow, LastCopyColumn).Address)
'Loop through each row of each column.
' This will go through each cell in column 1, then move on to column 2
For Col = 1 To LastCopyColumn
For cel = 1 To LastCopyRow
' If the string value of our current cell is not empty.
If rngCopy.Cells(cel, Col).Value <> "" Then
'Copy the source cell displayed color and paste it in the target cell
rngPaste.Cells(cel, Col).Interior.Color = rngCopy.Cells(cel, Col).DisplayFormat.Interior.Color
End If
Next cel
Next Col
End Sub
Simplest would be to apply the same conditional formatting to Sheet2, but use the values from Sheet1 as your criteria. So if Sheet1 Cell A1 has the value that makes it red, add formatting to Sheet2 that turns Sheet2 Cell A1 red as well.
There's a good explanation of how to achieve this here.
.Interior.Color gets the actual colour of the cell rather than the conditionally formatted colour (the one you see). So you can't copy/paste this red colour in your example in this way.
I believe that the only way to get the conditionally formatted colour you see would be to recompute whatever formula you've used in your conditionally formatting criteria.
Excel 2007 conditional formatting - how to get cell color?
Edit
While #JeffK627 was giving an elegant solution, I was knocking up some rough vba code to recompute what I gather your conditional formatting does. I've done this over range A1:A20 on sheet 2. At the moment it colours the cell that contains the value itself, but only requires a little tweak to colour the equivalent cell on another sheet.
Sub ColouringIn()
Dim intColIndex As Integer
Dim dblMax As Double
Dim dblMin As Double
Dim rngCell As Range
'RGB(255, 255, 255) = white
'RGB(255, 0, 0) = red
'so need to extrapolate between
dblMax = Application.WorksheetFunction.Max(Sheet2.Range("A1:A20"))
dblMin = Application.WorksheetFunction.Min(Sheet2.Range("A1:A20"))
For Each rngCell In Sheet2.Range("A1:A20")
If IsNumeric(rngCell.Value) And rngCell.Value <> "" Then
intColIndex = (rngCell.Value - dblMin) / (dblMax - dblMin) * 255
rngCell.Interior.Color = RGB(255, intColIndex, intColIndex)
End If
Next rngCell
End Sub
Adding following example as alternative solution, as I needed something dynamic/active where color IS a required condition of data & not reliant on any other trigger.
Option1:
Dim rngPrev2Update As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cellbox As Range
Dim rngDest As Range
If Not rngPrev2Update Is Nothing Then
For Each cellbox In rngPrev2Update.Cells
Worksheets("Sheet2").Range(cellbox.Address).Interior.ColorIndex = cellbox.Interior.ColorIndex
Next cellbox
End If
Set rngPrev2Update = Target
End Sub
This will update destination cells when cursor is next moved to another cell.
Option2:
Private Sub Worksheet_Activate()
Dim cellbox As Range
Dim rngCells As Range
Set rngCells = Range("B1:B10")
For Each cellbox In rngCells.Cells
Range(cellbox.Address).Interior.ColorIndex = Worksheets("Sheet2").Range(cellbox.Address).Interior.ColorIndex
Next cellbox
End Sub
Will update relevant cells on sheet load.
Note: If you have very large data set you may want to put this into a macro button &/or filter this further for only the cells you need, otherwise this may slow your spreadsheet down.
Appreciating this was some time ago. I would like to do a similar thing however would like to append the Interior Color Reference ie. 255 to the cells value.
so if cell A1 has Hello in the cell and is Colored Red I'd want in the other worksheet cell A1: Hello | 255
Just used | as a delimiter but anything sensible...