I have been trying to develop a code which highlights the Range(A to M) where Col"A" <> "" but my code just highlights the ColA how to add the range to code.
Any help will be appreciated.
Sub formatcell()
Dim Report As Worksheet
Dim lastRow As Integer
Dim i As Integer
Set Report = ActiveSheet
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
If Report.Cells(i, 1).Value <> "" Then
Report.Cells(i, 1).Interior.Color = RGB(255, 217, 102)
End If
Next i
End Sub
Try like this:
Dim ws As Worksheet, rng As Range
Set ws = ActiveSheet
On Error Resume Next 'skip error if no values
Set rng = ws.Columns("A").SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not rng Is Nothing Then
Application.Intersect(rng.EntireRow, ws.Range("A:M")).Interior.Color = vbYellow
End If
Related
I'm working on a macro that highlighted & colors the empty cells in a specific column (AE), but I need to clear this color-highlighted based on a result that exists in the column (AD)
If AD column, cells value = "SPLICE" clear color, If Empty the color should exist, below picture explains more.
I use the code below
Sub EmptyTerminalTO()
Application.ScreenUpdating = False
Sheets("Wire List").Activate
Dim i As Long
Dim c As Long
Dim myRange As Range
Dim myCell As Range
Set myRange = Range("AD2", Range("AD" & Rows.Count).End(xlUp))
For Each myCell In myRange '
c = c + 1
If (myCell) = "" Then
myCell.Interior.Color = RGB(255, 87, 87)
i = i + 1
End If
Next myCell
Rapport8 = i
Application.ScreenUpdating = True
End Sub
try using offset as per code below:
Option Explicit
Sub EmptyTerminalTO()
Application.ScreenUpdating = False
Sheets("Wire List").Activate
Dim i As Long
Dim c As Long, Rapport8 As Long
Dim myRange As Range
Dim myCell As Range
Set myRange = Range("AD2", Range("AD" & Rows.Count).End(xlUp))
For Each myCell In myRange '
c = c + 1
If myCell <> "SPLICE" & myCell.Offset(0, 1)="" Then
myCell.Offset(0, 1).Interior.Color = RGB(255, 87, 87)
Else
myCell.Offset(0, 1).Interior.Pattern = xlNone
i = i + 1
End If
Next myCell
Rapport8 = i
End Sub
I am trying to loop over a column L in my sheet and then color the cell red if value is not in “big box” and “small box”. The problem is I cannot figure out what I am doing wrong, and VBA is not throwing any errors now.
Sub data_validation_from_array()
Dim packages As Variant
Dim packages_range As Range
Dim cell_value As String
Dim vFilter
Set active_sheet = ActiveSheet
last_row = active_sheet.Range("L" & active_sheet.Rows.Count).End(xlUp).row
Set rng = active_sheet.Range("L2" & last_row)
packages = Array("big box", "small box")
For Each cel In rng
cell_value = cel.Value
vFilter = Filter(packages, cell_value, True)
If Not cell_value = vFilter(i) Then
cel.Interior.Color = vbRed
End If
Next cel
End Sub
Sub data_validation_from_array()
Dim packages_range As Range
Dim cell As Range
Dim last_row As Long
' you should use fully qualified reference here
' WORKSHEET_NAME: the name of the worksheet where the L column is
Set active_sheet = ThisWorkbook.Worksheets("WORKSHEET_NAME")
With active_sheet
last_row = .Range("L" & .Rows.Count).End(xlUp).Row
Set packages_range = .Range("L2", .Cells(last_row, "L"))
End With
For Each cell In packages_range
Select Case cell.Value
Case "big box": cell.Interior.Color = vbRed
Case "small box": cell.Interior.Color = vbRed
End Select
Next cell
Set packages_range = Nothing
Set cell = Nothing
End Sub
Need your help to get same objective to fill up the "null" value faster than below script .
Sub FillEmptyCell()
Dim rng As Range
Dim i As Long
Dim cell As Range
Dim sht As Worksheet
Set sht = ActiveWorkbook.Sheets("rawdata")
sht.Activate
Set rng = Range(Range("G2:G14614"), Range("G" & sht.UsedRange.Rows.Count))
For Each cell In rng
If cell.Value = "" Then cell.Value = "BLANKON"
Next
End Sub
Try,
Sub FillEmptyCell()
with workSheets("rawdata")
with .range(.cells(2, "G"), .cells(.rows.count, "G").end(xlup))
on error resume next
.specialcells(xlcelltypeblanks) = "BLANKON"
on error goto 0
end with
.Activate
end with
End Sub
I have few sheet that i would like to read all comments from each sheet.
I managed to get the comments but what i could get is the first cell of the same row and column of the commented cell.( attached photo)
red - commented cell.
green - required cell value.
Sub ShowCommentsAllSheets()
'Update 20140508
Dim commrange As Range
Dim rng As Range
Dim ws As Worksheet
Dim newWs As Worksheet
Set newWs = Application.Worksheets("CRs")
newWs.Range("A1").Resize(1, 4).Value = Array("Sheet", "A", "Value", "Comment")
Application.ScreenUpdating = False
On Error Resume Next
For Each ws In Application.ActiveWorkbook.Worksheets
Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
If Not commrange Is Nothing Then
i = newWs.Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In commrange
i = i + 1
newWs.Cells(i, 1).Resize(1, 4).Value = Array(ws.Name, rng.Address, rng.Value, rng.Comment.Text)
Next
End If
Set commrange = Nothing
Next
newWs.Cells.WrapText = False
Application.ScreenUpdating = True
End Sub
Perhaps just change this line?
newWs.Cells(i, 1).Resize(1, 5).Value = Array(ws.Name, rng.Address, rng.Value, rng.Comment.Text, ws.Cells(rng.Row, 2))
I have the following code that I am using as a workaround instead of filtering the data as I have multiple criterias. I read somewhere that it is only possible to filter 2 criterias at a time?
The thing is that I have 5 - AB, DZ, RE, Z3, ZP - everything else should be deleted. So I am using the code below, which works fine, but having to deal with +30000 rows everytime I run the macro, it is extremely slow.
Is there anyway you can do this faster? I was thinking of just filtering each criteria at a time (creating 5 of the first of the below codes). But if there is anyway to do it faster, I would appreciate some help.
THE CODE I USE THAT IS SLOW:
' Step 13 - Filter and Delete All Except
' AB, DZ, RE, Z3, ZP in Column 6 - Type
Sub FilterDeleteType()
Dim rTable As Range, r As Range
Dim rDelete As Range
Set rDelete = Nothing
Dim v As Variant
Worksheets("Overdue Items").Activate
For Each r In Columns(6).Cells
v = r.Value
If v <> "Type" And v <> "AB" And v <> "DZ" And v <> "RE" And v <> "Z3" And v <> "ZP" Then
If rDelete Is Nothing Then
Set rDelete = r
Else
Set rDelete = Union(r, rDelete)
End If
End If
Next
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub
You can just look in hidden rows and check that column -
Sub test()
Dim lastrow As Integer
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim lastcol As Integer
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
'do your autofilter here
For i = 1 To lastrow
If Rows(i).Hidden = True Then
Range(Cells(i, 1), Cells(i, 5)).ClearContents
Range(Cells(i, 7), Cells(i, lastcol)).ClearContents
If Cells(i, 6) <> "AB" Or "DZ" Or "RE" Or "Z3" Or "ZP" Then
Cells(i, 6).ClearContents
End If
End If
Next
End Sub
So I managed to do exactly what my previous code was doing, just significantly faster. With the help from this post https://stackoverflow.com/a/22275522
What the code is doing is that it filter the values that I want (using an array), and then it will delete the hidden rows, meaning the rows that has NOT been filtered.
Sub FilterType()
Dim LRow As Long
Dim delRange As Range
Dim oRow As Range, rng As Range
Dim myRows As Range
Const Opt1 As String = "AB"
Const Opt2 As String = "DZ"
Const Opt3 As String = "RE"
Const Opt4 As String = "Z3"
Const Opt5 As String = "ZP"
On Error GoTo ErrHandler:
Sheets(1).Activate
With ThisWorkbook.Sheets(1)
'~~> Remove any filters
.AutoFilterMode = False
LRow = .Range("F" & .Rows.Count).End(xlUp).Row
With .Range("F1:F" & LRow)
.AutoFilter Field:=1, Criteria1:=Array(Opt1, Opt2, Opt3, Opt4, Opt5), Operator:=xlFilterValues
End With
With Sheets(1)
Set myRows = Intersect(.Range("F:F").EntireRow, .UsedRange)
If myRows Is Nothing Then Exit Sub
End With
For Each oRow In myRows.Columns(6).Cells
If oRow.EntireRow.Hidden Then
If rng Is Nothing Then
Set rng = oRow
Else
Set rng = Union(rng, oRow)
End If
End If
Next
ErrHandler:
'~~> Remove any filters
.AutoFilterMode = False
End With
If Not rng Is Nothing Then rng.EntireRow.Delete
End Sub