I want to change the macro below to make it changes the color of part of the row, not the cell, based on the cell value.
If the value in cell E2 is "proof", then cells A2-E2 become red.
Sub ChangeColor()
lRow = Range("E" & Rows.Count).End(xlUp).Row
Set MR = Range("E2:E" & lRow)
For Each cell In MR
If cell.Value = "Proof" Then cell.Interior.ColorIndex = 3
Next
End Sub
It's a relatively simple change. Change cell.Interior.ColorIndex = 3 to a specific range as seen in the procedure below.
Sub ChangeColor()
lRow = Range("E" & Rows.Count).End(xlUp).Row
Set MR = Range("E2:E" & lRow)
For Each cell In MR
If cell.Value = "Proof" Then range("a" & cell.row & ":e" & cell.row).Interior.ColorIndex = 3
Next
End Sub
If you have a lot of rows to process, you may wish to abandon the loop process and work with a filter instead.
For A:E highlighting:
Sub highlight_Proof()
With ActiveSheet
With .Cells(1, 1).CurrentRegion
.Cells.Interior.Pattern = xlNone
If .AutoFilter Then .AutoFilter
.AutoFilter Field:=5, Criteria1:="=proof"
With .Offset(1, 0).Resize(.Rows.Count - 1, 5)
If CBool(Application.Subtotal(103, .Cells)) Then _
.SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 3
End With
.AutoFilter
End With
End With
End Sub
For full row highlighting:
Sub highlight_Proof2()
With ActiveSheet
With .Cells(1, 1).CurrentRegion
If .AutoFilter Then .AutoFilter
.AutoFilter Field:=5, Criteria1:="=proof"
With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
If CBool(Application.Subtotal(103, .Cells)) Then _
.SpecialCells(xlCellTypeVisible).EntireRow.Interior.ColorIndex = 3
End With
.AutoFilter
End With
End With
End Sub
I haven't wildcarded the search for proof but that is a small modification. It seems that your original code was looking for the entire cell value.
With Conditional Formatting, select ColumnsA:E, HOME > Conditional Formatting, New Rule..., Use a formula to determine which cells to format, Format values where this formula is true::
=$E1="proof"
Format..., select red, OK, OK.
Related
I am working on my code and I have this to filter rows and insert a formula in the first filter row. with that formula I want it to fill down, but it only insert the formula in the first filtered row and doesn't fill down.
Sub Cal()
dim LastRow as long
With Worksheets("Data")
.Range("$A$1:$AI$80000").AutoFilter Field:=1, Criteria1:= _
"Actual"
.Range("$A$1:$AI$80000").AutoFilter Field:=2, Criteria1:="2018"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.AutoFilter.Range.Offset(2).SpecialCells(xlCellTypeVisible).Cells(1, 35).Select 'SELECTS THE FIRST cell in A after deleting
ActiveCell.FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
.AutoFilter.Range.Offset(2).SpecialCells(xlCellTypeVisible).Cells(1, 35).Select
Selection.FillDown
End With
End Sub
How about something like below, instead of .FillDown, specify the range for the last column of visible data, and offset to the next column to enter the formula in there:
Sub Cal()
Dim LastRow As Long
With Worksheets("Data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("$A$1:$AI$" & LastRow).AutoFilter Field:=1, Criteria1:="Actual"
.Range("$A$1:$AI$" & LastRow).AutoFilter Field:=2, Criteria1:="2018"
'filter according to values specified
Set fltrdrng = .Range("$AI$2:$AI$" & LastRow).SpecialCells(xlCellTypeVisible)
'set the range of visible data on last column with data on your data-set
fltrdrng.Offset(0, 1).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
'add the formula to the adjacent column by offsetting
End With
End Sub
This should do what you want. Autofilling is very dangerous with filtered data. This gets the activecell address and then creates the last cell address(row 80000 from your code), and then adds the formula to every cell in the range that is visible.
Start = ActiveCell.address
arow = ActiveCell.Row
alen = Len(arow)
lcell = Left(Start, Len(Start) - alen) & "80000"
Range(Start & ":" & lcell).SpecialCells(xlCellTypeVisible).Formula = "=SUM(RC[-12]:RC[-1])"
I'm trying to add 2 columns with formulas and autofill down to the last row, but I'm getting an
Autofill method of range class failed
when running the code. It breaks at the line that starts with Activecell.Autofill
Sub addColumnsandChange()
Dim LastRow As Integer
'Finds the value of the last row
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
ActiveCell.FormulaR1C1 = "YoY% Change"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "3 Year CAGR"
ActiveCell.Offset(1, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IFERROR((RC[-1]-RC[2])/RC[2],"""")"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IFERROR((RC[-2]/RC[2])^(1/3)-1,"""")"
ActiveCell.Offset(0, -1).Range("A1:B1").Select
ActiveCell.AutoFill Range("A1:B" & LastRow), Type:=xlFillDefault
Range("A1:B" & LastRow).Select
End Sub
Since incorporating the LastRow variable I have not been able to run the code.
Instead it returns a run-time error
Autofill method of range class failed
when debugging. How should I autofill and end the code?
While it is unclear on where you actually start (e.g. what cell Selection is), I suppose that it could be assumed that you know what you are doing before running the sub procedure. In any event, it is better to .FillDown or simply write the formulas all at once.
Using .FillDown:
Sub addColumnsandChange()
Dim lastRow As Long
'Finds the value of the last row
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
With Selection.Cells(1)
.Resize(lastRow, 2).EntireColumn.Insert
.Offset(0, -2).Resize(1, 2) = Array("YoY% Change", "3 Year CAGR")
.Offset(1, -2).FormulaR1C1 = "=IFERROR((RC[-1]-RC[2])/RC[2], TEXT(,))"
.Offset(1, -1).FormulaR1C1 = "=IFERROR((RC[-2]/RC[2])^(1/3)-1, TEXT(,))"
.Offset(1, -2).Resize(lastRow - 1, 2).FillDown
.Offset(0, -2).Resize(lastRow, 2).Select
End With
End Sub
Writing all formulas at once:
Sub addColumnsandChange()
Dim lastRow As Long
'Finds the value of the last row
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
With Selection.Cells(1)
.Resize(lastRow, 2).EntireColumn.Insert
.Offset(0, -2).Resize(1, 2) = Array("YoY% Change", "3 Year CAGR")
.Offset(1, -2).Resize(lastRow - 1, 2).FormulaR1C1 = "=IFERROR((RC[-1]-RC[2])/RC[2], TEXT(,))"
.Offset(1, -1).Resize(lastRow - 1, 2).FormulaR1C1 = "=IFERROR((RC[-2]/RC[2])^(1/3)-1, TEXT(,))"
.Offset(0, -2).Resize(lastRow, 2).Select
End With
End Sub
You are trying to autofill starting with the first row.
However, the formulas you are trying to copy are on the second row. Your first row contains header text.
Please note: You don't have to Select a cell before changing it's value. Your code would perform much faster if you would leave our those Selects. (And the code would become much easier to read and understand)
I have a sheet called Backlog containing rows and columns of data. I need code that will search row by row in the 2nd to last column looking for #N/A. When it finds #N/A it needs to check the last column if it contains a C or not. If it contains a C then the whole row should be appended to a sheet called Logoff. If the last column does not contain a C then the whole row should be appended to a sheet called Denied. The row should be deleted from the original Backlog sheet once moved to either Logoff or Denied. The code I have below is not working. After the first For Statement it goes to End Sub, but there is not any compiling errors.
Private Sub CommandButton2_Click()
Dim IMBacklogSh As Worksheet
Set IMBacklogSh = ThisWorkbook.Worksheets("Backlog")
Dim logoffSh As Worksheet
Set logoffSh = ThisWorkbook.Worksheets("Claims Logged off")
Dim deniedsh As Worksheet
Set deniedsh = ThisWorkbook.Worksheets("Claims Denied")
IMBacklogSh.Select
Dim i As Long
For i = 3 To Cells(Rows.Count, 13).End(xlUp).Row
If Cells(i, 13).Value = "#N/A" Then
If Cells(i, 14).Value = "C" Then
IMBacklogSh.Rows(i).EntireRow.Copy Destination:=logoffSh.Range("A" & logoffsh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
Else
IMBacklogSh.Rows(i).EntireRow.Copy Destination:=deniedsh.Range("A" & deniedsh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
End If
End If
Next i
End Sub
Try it as If Cells(i, 13).Text = "#N/A" Then . #N/A is an error code, not a value; however, the Range.Text property can be examined or the IsError function could be used to examine the cell's contents for any error.
If Cells(i, 13).Text = "#N/A" Then
'Alternate with IsError
'If IsError(Cells(i, 13)) Then
If Cells(i, 14).Value = "C" Then
IMBacklogSh.Rows(i).EntireRow.Copy _
Destination:=logoffSh.Range("A" & logoffsh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
Else
IMBacklogSh.Rows(i).EntireRow.Copy _
Destination:=deniedsh.Range("A" & deniedsh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
End If
End If
However, individual cell examination is not necessary and time consuming. The AutoFilter method can be used to isolate #N/A with C and #N/A with <>C.
Private Sub CommandButton2_Click()
Dim IMBacklogSh As Worksheet, logoffSh As Worksheet, deniedsh As Worksheet
Set IMBacklogSh = ThisWorkbook.Worksheets("Backlog")
Set logoffSh = ThisWorkbook.Worksheets("Claims Logged off")
Set deniedsh = ThisWorkbook.Worksheets("Claims Denied")
With IMBacklogSh
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, 1).CurrentRegion
.AutoFilter field:=13, Criteria1:="#N/A"
.AutoFilter field:=14, Criteria1:="C"
With .Resize(.Rows.Count - 1, Columns.Count).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.Copy Destination:= _
logoffSh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'optionally delete the originals
.EntireRow.Delete
End If
End With
.AutoFilter field:=14, Criteria1:="<>C"
With .Resize(.Rows.Count - 1, Columns.Count).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.Copy Destination:= _
deniedsh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'optionally delete the originals
.EntireRow.Delete
End If
End With
End With
If .AutoFilterMode Then .AutoFilterMode = False
End With
End Sub
I was trying to figure out how to have excel look at a cell in my workbook, if the cell has a value greater than 0 then copy that row into sheet2. It then looks at the next cell in the column.
Does anyone know??
I need it looking at cell I10 to start off and if I10>0 copy data from A10:K10 to sheet2 else look at I11 and repeat, then I12... until all 750+ rows are either copied or not.
Thanks so much for all the help!!!
Option Explicit
Sub Macro1()
Dim cell As Range
Dim lastRow As Long, i As Long
lastRow = Range("I" & Rows.Count).End(xlUp).Row
i = 10 ' change this to the wanted starting row in sheet2
For Each cell In Sheets(1).Range("I10:I" & lastRow)
If cell.Value > 0 Then
cell.EntireRow.Copy Sheets(2).Cells(i, 1)
i = i + 1
End If
Next
End Sub
you can use AutoFilter() method of Range object and avoid looping through cells:
Sub Main()
With Worksheets("OriginWs") '<--| change "OriginWs" to your actual data worksheet name
With .Range("I9", .Cells(.Rows.Count, "I").End(xlUp))
If IsEmpty(.Cells(1, 1)) Then .Cells(1, 1) = "dummyheader"
.AutoFilter Field:=1, Criteria1:=">0"
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Offset(1, -8).Resize(.Rows.Count - 1, 11).SpecialCells(xlCellTypeVisible).Copy Worksheets("TargetWs").Cells(1, 1) '<--| change "TargetWs" to your actual destination worksheet name
If .Cells(1, 1).Value = "dummyheader" Then .Cells(1, 1).ClearContents
End With
.AutoFilterMode = False
End With
End Sub
BTW, the statements:
If IsEmpty(.Cells(1, 1)) Then .Cells(1, 1) = "dummyheader"
and
If .Cells(1, 1).Value = "dummyheader" Then .Cells(1, 1).ClearContents
can be avoided if your cell I9 has some text for sure
I need help regarding the screenshot above. If possible I want a vba code that starts checking in F2 cell in row F(Unit Price) and change the adjacent values of row H and I to "01/01/2010" if the value on unit price is 0 and loop until an empty cell. Thanks in advance.
Range("F1").Select
ActiveSheet.Range("$A$1:$AI$9036").AutoFilter Field:=6, Criteria1:="0"
Range("H3").Select
ActiveCell.FormulaR1C1 = "1/1/2010"
Selection.AutoFill Destination:=Range("H3:I3"), Type:=xlFillCopy
Range("H3:I3").Select
Selection.FillDown
ActiveSheet.Range("$A$1:$AI$9036").AutoFilter Field:=6
Tried this one but the value doesnt change
Sub test()
irow = 2
Do
If (Sheets("Prices").Cells(6, 1).Value = 0) Then Cells(8, 1).Value = "01/01/2010"
irow = irow + 1
Loop Until IsEmpty(Sheets("Prices").Cells(irow, 6))
End Sub
This one works in less than 1 sec with 100,000 rows:
Option Explicit
Public Sub updateDates()
With ThisWorkbook.ActiveSheet.UsedRange
If ActiveSheet.AutoFilter Is Nothing Then .AutoFilter
.AutoFilter Field:=6, Criteria1:="0"
.Columns(8).Offset(1).Resize(.Rows.Count - 1) = "1/1/2010"
.AutoFilter
End With
End Sub
For i = 1 To 100000
With Sheets("Prices")
If .Range("F" & i).Value = "0" Then _
.Range("H" & i).Value = "01/01/2010"
End With
Next i
This one worked