Anbuselvam
Board Regular
- Joined
- May 10, 2017
- Messages
- 97
Dear All
Find the below dropbox linked sheet, In that, I want to find the yellow-coloured cells and it must be documented to the new sheet with its value, cell address and the Heading of the same.
For that, I tried below code and I got error 438
Note: Similar question posted in chandoo.org and the link is below for your information
Find the below dropbox linked sheet, In that, I want to find the yellow-coloured cells and it must be documented to the new sheet with its value, cell address and the Heading of the same.
For that, I tried below code and I got error 438
Dropbox - File Deleted - Simplify your life
www.dropbox.com
Note: Similar question posted in chandoo.org and the link is below for your information
VBA - Document particular cells value, address and heading to New Sheet
Dear All Find the attached sheet, In that, I want to find the yellow-coloured cells and it must be documented to the new sheet with its value and cell address. For that, I tried below code and I got error 438 Option Explicit Sub SelectColoredCells() Dim Sh As Worksheet Dim rCell As...
chandoo.org
VBA Code:
Option Explicit
Sub SelectColoredCells()
Dim Sh As Worksheet
Dim rCell As Range, PDate As Range
Dim lColor As Long, r As Long
Dim rColored As Range
Dim High As Date
Application.ScreenUpdating = False
' Create a new sheet
Set Sh = Worksheets.Add
lColor = RGB(255, 255, 0)
Set rColored = Nothing
For Each rCell In Sheet9.Range("A7:BD800")
If rCell.Interior.Color = lColor Then
If rColored Is Nothing Then
Set rColored = rCell
Else
Set rColored = Union(rColored, rCell)
End If
End If
Next
If rColored Is Nothing Then
MsgBox "No cells match the color"
Else
With Sh
'Put header "Comment", "Address" & "Author" in A1, B1 & C1 respectively.
.Cells(1, 1).Value = "Value"
.Cells(1, 2).Value = "Cell Address"
r = 2
For Each rColored In Sheet9
.Cells(r, 1).Value = rColored.Value
.Cells(r, 2).Value = rColored.Parent.Address
r = r + 1
Next rColored
.Columns.AutoFit
End With
End If
End Sub