I am trying to automate a massive report and one step of the process involves changing the row color based on the value in column B.
Essentially, if B# = "SCC NUPSFTPDE", then I need the row color to be a light blue. (I'm not overly concerned with the exact color TBH).
I've been trying to manipulate code and have basically made my own Frankenstein code so I'm sure it's wrong somewhere in here. Please help!
Dim LastRow As Long
Dim cell As Range
sSheetName = ActiveSheet.Name
With Worksheets(sSheetName)
LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
**For Each cell In Range("B2:B" & LastRow)
If cell.Value = "SCC NUPSFTPDE" Then
ColorRow = 39**
Else
cell.EntireRow.Interior.ColorIndex = xlNone
End If
Next
End With
Just to close this question out: change
ColorRow = 39
to
cell.EntireRow.Interior.ColorIndex = 39
or perhaps better, something like
cell.EntireRow.Interior.Color = RGB(129, 218, 239)
You could also try worksheet event - Worksheet_Change which apply the color in every change automatically.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim LastRow As Long
With Me
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
If Not Intersect(Target, .Range("B2:B" & LastRow)) Is Nothing Then
For Each cell In Target
Application.EnableEvents = False
If cell.Value = "SCC NUPSFTPDE" Then
cell.EntireRow.Interior.ColorIndex = 39
Else
cell.EntireRow.Interior.ColorIndex = xlNone
End If
Application.EnableEvents = True
Next cell
End If
End With
End Sub
Related
sub copycolmns() **code for copying columns data along with header in another sheet name paste sheet**
Sheets("copysheet1").Columns(11).Copy Destination:=Sheets("paste").Columns(1)
Sheets("copysheet2").Range("A1:A20").Copy
Sheets("paste").Range("B1").PasteSpecial xlPastevalues
End Sub
Sub reconncilirecords() ** this function to reconcile records and color them green if matching**
Dim col1 As Range, col2 as Range,Prod1 as String, Prod2 as String
Set col1 = Sheets("paste").Columns("A")
Set col2 = Sheets("Paste").Columns("B")
lr = Sheets("paste").Columns("A:B").SpecialCells(xlCellTypeLastCell).Row
For r = 2 to lr
Prod1 = Cells(r, col1.Column).Value
Prod2 = Cells(r, col2.Column).Value
If Prod1 = Prod2 Then
Cells(r, col1.Column).Interior.Color = vbGreen
Cells(r, col2.Column).Interior.Color = vbGreen
Else
Cells(r, col1.Column).Interior.Color = vbRed
Cells(r, col2.Column).Interior.Color = vbRed
End If
Next r
End Sub
Sub Result() **function to display if marching or not matching with message box**
Dim wj as Wrokbook
Dim ws_data as worksheet
Dim rng_data as Range
Set wj = Activeworkbook
Set ws_data = ws.Sheets("paste")
Dim last_row as Long
last_row = ws_data.Cells(Rows.Count, "A").End(xlup).Row
Set rng_data = Range("A2:A" & last_row)
If rng_data.Interior.Color = RGB(0,255,0) then
Msgbox" details verfd and matching"
Else
Msbxo "Mismatch found"
End If
End Sub
is there any way to speed up this process as whenever i run reconcile data 2nd sub function macro is getting hanged. Is there any other way to dynamically copy from sheet1 and sheet2 and recocnile the data and apply message box to check for last row.
Building on my comment; this is a mock-up, so untested... should give an idea:
destWS.Columns(1).value = sourceWS1.columns(2).value
destWS.Columns(2).value = sourceWS2.columns(2).value
With destWS.Range("A1:B" & destLastRow)
.FormatConditions.Add Type:=xlExpression, Formula1:="=$A1=$B1"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.Color = vbRed
End With
End With
End With
You will most likely want to use exact ranges, not columns, as it slows things down... a lot.
I'm a beginner. Just learning by Googleing, but cannot find a solution for this. Please help.
I want to run the below macro.
I have multiple cells named "CV_=CVCAL" in the same column.
What I want is for the macro to find the first cell with the value "CV_=CVCAL" and offset to the adjacent cell. If the adjacent cell has a particular value, if the value is below lets say "1.5" i want to fill it will a cell style 'bad'.
I want the macro to go through all the cells that have the name CV_=CVCAL and do the same thing until there is no more cells named CV_=CVCAL.
Sub If_CV()
Range("A1").Select
Set FoundItem = Range("C1:C1000").Find("CV_=CVCAL")
FoundItem.Offset(columnOffset:=1).Select
If ActiveCell.Value >= 1.5 Then
ActiveCell.Style = "Bad"
End If
End Sub
Sounds like you want to loop through your values.
Determine the end of your range
Loop through your range and check your criteria
Sub If_CV()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, i As Long
lr = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
For i = 2 To lr
If ws.Range("C" & i) = "CV_=CVCAL" Then
If ws.Range("D" & i) >= 1.5 Then
ws.Range("D" & i) = "Bad"
End If
End If
Next i
End Sub
A basic loop would be simpler:
Sub If_CV()
Dim c As Range, ws As Worksheet
For Each ws in ActiveWorkbook.Worksheets
For Each c in ws.Range("C1:C1000").Cells
If c.Value = "CV_=CVCAL" Then
With c.offset(0, 1)
If .Value >= 1.5 Then .Style = "Bad"
End With
End If
Next ws
Next c
End Sub
I'm trying to find a VBA code that would highlight appropriate row within the range "A7:AD100" if a cell in the column "AB" has value "Elective."
Sub highlight()
Dim cell As Range
Range(Range("AB7"), Range("AB7").End(xlDown)).Select
For Each cell In Selection
If cell = "Elective" Then Cells.Range($A7, $AD7).Interior.ColorIndex = 10
Next cell
End Sub
Only rows 1, 11, 21, 23 are highlighted since they have Admit Type = "Elective". The rows highlighted only within the range "A:AD" (I don't want the whole row to be highlighted).
I found this code that works for me
Sub HighlightCells()
Dim rngMyCell As Range
Dim lngLastRow As Long
Application.ScreenUpdating = False
lngLastRow = Cells(Rows.Count, "AB").End(xlUp).Row
For Each rngMyCell In Range("AB7:AB" & lngLastRow)
If StrConv(rngMyCell, vbProperCase) = "Elective" Then
Range("A" & rngMyCell.Row & ":AD" & rngMyCell.Row).Interior.Color = RGB(240, 240, 240)
End If
Next rngMyCell
Application.ScreenUpdating = True
End Sub
I am trying to loop down the column "Q" on my active sheet, find values that are in between 27 and 40 and then copy that cell along with a region around the cell noted by the (-1, -16) into a new sheet.
Right now I am just making the region bold to make sure that my loop is catching the right values and regions.
I"m new to VBA so if anyone can give me some pointers or advise on how to solve my problem I'd be very appreciative.
Sub Test2()
Application.ScreenUpdating = False
ActiveSheet.Range("Q13").Select
Let x = 0
Do While x < 500
If ActiveCell.Value >= 27 And ActiveCell.Value <= 40 Then
Range(ActiveCell, ActiveCell.Offset(-1, -16)).Select
Selection.Font.Bold = True
ActiveCell.Offset(2, 16).Activate
Else
ActiveCell.Offset(1, 0).Select
End If
x = x + 1
Loop
End Sub
Try below code :
Always set the ScreenUpdating property back to True when your macro
ends.Check this link
Avoid using Select/Activate in your code. Check this link
Always explicitly specify the sheet when working with more than one
sheet.
Avoid using ActiveCell,ActiveSheet and refer to them explicitly.
Sub Test2()
Application.ScreenUpdating = False
Dim lastRow As Long
lastRow = Sheets("sheet1").Range("Q" & Rows.Count).End(xlUp).Row
Dim rng As Range, cell As Range
Set rng = Sheets("sheet1").Range("Q1:Q" & lastRow)
For Each cell In rng
If cell.Value >= 27 And cell.Value <= 40 Then
Sheets("sheet1").Range(cell, cell.Offset(0, -16)).Copy Sheets("sheet2").Cells(Sheets("sheet2").Range("Q" & Rows.Count).End(xlUp).Row + 1, 1)
End If
Next
Application.ScreenUpdating = True
End Sub
I've come up with the following to alternate row colors within a specified range:
Sub AlternateRowColors()
Dim lastRow as Long
lastRow = Range("A1").End(xlDown).Row
For Each Cell In Range("A1:A" & lastRow) ''change range accordingly
If Cell.Row Mod 2 = 1 Then ''highlights row 2,4,6 etc|= 0 highlights 1,3,5
Cell.Interior.ColorIndex = 15 ''color to preference
Else
Cell.Interior.ColorIndex = xlNone ''color to preference or remove
End If
Next Cell
End Sub
That works, but is there a simpler method?
The following lines of code may be removed if your data contains no pre-exisiting colors:
Else
Cell.Interior.ColorIndex = xlNone
I need to do this frequently and like to be able to easily modify the colors I'm using for the banding. The following sub makes it very easy:
Sub GreenBarMe(rng As Range, firstColor As Long, secondColor As Long)
rng.Interior.ColorIndex = xlNone
rng.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=0"
rng.FormatConditions(1).Interior.Color = firstColor
rng.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)<>0"
rng.FormatConditions(2).Interior.Color = secondColor
End Sub
Usage:
Sub TestGreenBarFormatting()
Dim rng As Range
Dim firstColor As Long
Dim secondColor As Long
Set rng = Range("A1:D12")
firstColor = vbGreen
secondColor = vbYellow
Call GreenBarMe(rng, firstColor, secondColor)
End Sub
Alternating row colors can be done using conditional formatting:
I needed a macro that would color every second row in a range, using only those rows that were visible. This is what I came up with. You don't have to loop through the rows.
Sub Color_Alt_Rows(Rng As Range)
Application.ScreenUpdating = False
Rng.Interior.ColorIndex = xlNone
Rng = Rng.SpecialCells(xlCellTypeVisible)
Rng.FormatConditions.Add Type:=xlExpression, Formula1:="=mod(row()+1,2)"
Rng.FormatConditions(1).Interior.ColorIndex = 34
End Sub
Try it out with Color_Alt_Rows Range("a2:d5")
My Solution
A subroutine to assign to a button or some code
Public Sub Band_Goals()
'Just pass the start and end rows
'You will have to update the function to select the
'the correct columns
BandRows_Invisble 12, 144
End Sub
The Function
Private Sub BandRows_Invisble(StartRow As Integer, EndRow As Integer)
Dim i As Long, nothidden As Boolean
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("A" & StartRow & ":K" & EndRow).Interior.ColorIndex = xlNone
For i = StartRow To EndRow
If Not Rows(i).Hidden Then
nothidden = nothidden + 1
If Not nothidden Then
'Download this app to help with color picking
'http://www.iconico.com/download.aspx?app=ColorPic
Range("A" & i & ":K" & i).Interior.Color = RGB(196, 189, 151)
End If
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
'--- Alternate Row color, only non-hidden rows count
Sub Test()
Dim iNumOfRows As Integer, iStartFromRow As Integer, iCount As Integer
iNumOfRows = Range("D61").End(xlDown).Row '--- counts Rows down starting from D61
For iStartFromRow = 61 To iNumOfRows
If Rows(iStartFromRow).Hidden = False Then '--- only non-hidden rows matter
iCount = iCount + 1
If iCount - 2 * Int(iCount / 2) = 0 Then
Rows(iStartFromRow).Interior.Color = RGB(220, 230, 241)
Else
Rows(iStartFromRow).Interior.Color = RGB(184, 204, 228)
End If
End If
Next iStartFromRow
End Sub
Well, you can delete the else part, since you will leave it in the default color
In my Excel 2010, there is an option to format as table, where you can also select a range and headers. No need for scripting.
set these up initialized somewhere:
Dim arr_Lng_Row_Color(1) As Long
arr_Lng_Row_Color(0) = RGB(int_Color_1_R, int_Color_1_G, int_Color_1_B)
arr_Lng_Row_Color(1) = RGB(int_Color_2_R, int_Color_2_G, int_Color_2_B)
On any row you wish this will set the color
ws_SomeSheet.Rows(int_Target_Row).EntireRow.Interior.Color = arr_Lng_Row_Color(int_Target_Row Mod 2)