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")
Related
I have code that will go to a range and insert a formula all the way down. The below code will go to range N17:N160 and insert a relative formula.
Sub Macro9()
Range("n17:n160").FormulaR1C1 = "=IF(RC[-11]="""","""",IFERROR(VLOOKUP(RC[-11],R17C42:R160C53,7,FALSE),""""))"
End Sub
It works. However, I need to add a level where it looks at range B17:B160 and any cell in that range that has a "Y" in it will not update with the formula, whereas any one without a "Y", will update. Basically if and row has a Y in column B, don't put the formula in, for every other cell in the range, do put the formula in.
Thanks
First time posting, sorry if I didn't format everything correctly.
You'll need to build a range reference that meest your criteria for adding the Formula,
Something like
Sub Macro9()
Dim rng As Range, rngFiltered As Range
Dim dat As Variant
Dim idx As Long
Set rng = Range("n17:n160")
dat = rng.Offset(0, -12).Value2 ' Column B data
rng.ClearContents ' Clear existing data from range
For idx = 1 To UBound(dat)
If dat(idx, 1) <> "y" Then
If rngFiltered Is Nothing Then
Set rngFiltered = rng.Cells(idx, 1)
Else
Set rngFiltered = Application.Union(rngFiltered, rng.Cells(idx, 1))
End If
End If
Next
rngFiltered.FormulaR1C1 = "=IF(RC[-11]="""","""",IFERROR(VLOOKUP(RC[-11],R17C42:R160C53,7,FALSE),""""))"
End Sub
I'm trying to build a VBA application that checks for a certain value, then adds a row on top for each time this value is found.
Sub copy()
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("B2:B10")
For Each row In rng.Rows
For Each cell In row.Cells
If cell.value = "test" Then
MsgBox "found" + cell.Address
cell.EntireRow.Insert
End If
Next cell
Next row
End Sub
Every time I try to run this function, however, it keeps adding rows on top of each other continuously and not for each occurrence.
If you loop the cells from top to bottom, adding the row will push your original range down, causing the next loop to evaluate the previous cell.
To avoid this, loop backwards (i.e. bottom to top):
Sub copy_test()
Dim rng As Range
Set rng = Range("B2:B10")
Dim i As Long
For i = rng.Cells.Count To 1 Step -1
If rng.Cells(i).Value = "test" Then
Debug.Print "Found"
rng.Cells(i).EntireRow.Insert
End If
Next i
End Sub
Note: Set rng = Range("B2:B10") is telling VBA that you are referring to Cells B2:B10 of the ActiveSheet which might not be what you want.
Please fully qualify your range to avoid this. (e.g. ThisWorkBook.Worksheets("Sheet1").Range("B2:B10") or use the code name of the worksheet Sheet1.Range("B2:B10").)
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 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
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...