Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 93
  • Last Modified:

Redacting a row in Excel based on a term.

I have a set of 20 Excel files that need to have information redacted from them.  For the purpose of redaction, I just need to change the background and text to black.

For each row in my worksheet, I want to search for the text ‘Acme’.  If ‘Acme’ can’t be found in any field for a given row, I want to redact the entire row.

Does anyone know of the best way to do this?  I know that Conditional Formatting, Macros and COM automation are all options.  I am hoping someone can give me some direction to limit my research time.

Thank you in advance.
0
rye004
Asked:
rye004
1 Solution
 
Mike in ITIT System AdministratorCommented:
Using VBA, you could search each cell going through them one row at a time and if the "Acme" is not in the row then change the back ground color and text color. Maybe something like this:

Sub SearchAcme()
Dim RowNumber, CountRows
CountRows = Worksheets(1).Range("A:A").Cells.SpecialCells(xlCellTypeConstants).count
RowNumber = 1
For j = RowNumber To CountRows Step 1
    For i = 1 To 100
        Range(i & j).Select
        If Range(i & j).Value = "Acme" Then
            Range(i & ":" & i).EntireRow.Interior.ColorIndex = 1
            Range(i & ":" & i).EntireRow.Font.Color = vbBlack
        End If
    Next j
Next i
End Sub

Open in new window


This is untested code though.
1
 
Martin LissOlder than dirtCommented:
You should also protect (lock) the redacted cells and protect the worksheet with the "Select locked cells" option turned off, otherwise selecting the cell will show the text in the formula bar.
0
 
Rgonzo1971Commented:
Hi,

pls try
Sub BlackenAcme()
Dim rw
ActiveSheet.Unprotect
Cells.Locked = False
For Each rw In Range(Range("A1"), Range("A" & Cells.Rows.Count).End(xlUp))
    If Evaluate("=Countif(" & rw.EntireRow.Address & ",""acme"")") Then
        rw.EntireRow.Interior.ColorIndex = 1
        rw.EntireRow.Locked = True
    End If
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

Open in new window

Regards
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
rye004Author Commented:
I am still having issues with this.  I could not get either to work above.  I tried the following, with no luck.

Sub BlackenAcme()
Dim rw
ActiveSheet.Unprotect
Cells.Locked = False
For Each rw In Range(Range("A1"), Range("A" & Cells.Rows.Count).End(xlUp))
    
    If (Range(rw.EntireRow.Address).Find(What:="acme", MatchCase:=False) = 0) Then
        rw.EntireRow.Interior.ColorIndex = 1
        rw.EntireRow.Locked = True
    End If
    
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
You seem to want to look in just column "A" is that right?
Sub BlackenAcme()
Dim rw As Range
Dim rngFound As Range
ActiveSheet.Unprotect
Cells.Locked = False
For Each rw In Range(Range("A1"), Range("A" & Cells.Rows.Count).End(xlUp))
    
    Set rngFound = rw.EntireRow.Find(What:="acme", MatchCase:=False)
    If Not rngFound Is Nothing Then
        rw.EntireRow.Interior.ColorIndex = 1
        rw.EntireRow.Locked = True
    End If
    
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
If you want to look for "acme" everywhere then change line 6 to
For Each rw In ActiveSheet.UsedRange

Open in new window

0
 
rye004Author Commented:
Thank you so much Martin, that was a huge help.  Below is what I have now, I am going to try it on the rest of my Excel sheets:

Sub BlackenAcme()
Dim rw As Range
Dim rngFound As Range
ActiveSheet.Unprotect
Cells.Locked = False
For Each rw In ActiveSheet.UsedRange
    
    Set rngFound = rw.EntireRow.Find(What:="acme", MatchCase:=False)
    'If Not rngFound Is Nothing Then
    If rngFound Is Nothing Then
        rw.EntireRow.Interior.ColorIndex = 1
        rw.EntireRow.Locked = True
    End If
    
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Changing line 9 the way you did will blacken the rows that don't contain acme.
0
 
rye004Author Commented:
That is the behavior I was looking for.  I might have miss spoken in my original posting, but thanks for checking.

I do have another question if you don’t mind.  Is it possible to blackout only the Used Range instead of the entire row?
0
 
Martin LissOlder than dirtCommented:
??I'm confused by your two responses. If a sheet looks like this, which cells or rows should be black?
0
 
rye004Author Commented:
rows 2,3,4,5,6,8 and 9 would be blacked out.

It would be great if column E and F were not blacked out, since they are not in the used range.
0
 
Martin LissOlder than dirtCommented:
Rows 8 and 9 are not in the used range either. Do you still want them blackened?
0
 
rye004Author Commented:
You are correct.  8 and 9 are not in the used ranged, so I would not want them blacked out.
0
 
Martin LissOlder than dirtCommented:
Sub BlackenAcme()
Dim rw As Range
Dim rngFound As Range
ActiveSheet.Unprotect
Cells.Locked = False
For Each rw In ActiveSheet.UsedRange
    
    Set rngFound = rw.EntireRow.Find(What:="acme", MatchCase:=False)
    If rngFound Is Nothing Then
        With Range("A" & rw.Row & ":" & Split(Cells(1, ActiveSheet.UsedRange.Columns.Count).Address, "$")(1) & rw.Row)
            .Interior.ColorIndex = 1
            .Locked = True
        End With
    End If
    
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Forget my previous post. This will be faster and easier to understand. (BTW you might want to change the name of the macro since that's not what we're doing.)
Sub BlackenAcme()

Dim rw As Range
Dim rngRows As Range
Dim rngFound As Range

ActiveSheet.Unprotect
Cells.Locked = False

Set rngRows = ActiveSheet.UsedRange
For Each rw In rngRows.Rows
    
    Set rngFound = rw.Find(What:="acme", MatchCase:=False)
    If rngFound Is Nothing Then
        With rw
            .Interior.ColorIndex = 1
            .Locked = True
        End With
    End If
    
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

Open in new window

0
 
rye004Author Commented:
Thanks again for your help with this Martin.  It is truly appreciated.
0
 
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

If you expand the “Full Biography” section of my profile you'll find links to some articles I've written that may interest you.

Marty - Microsoft MVP 2009 to 2016
              Experts Exchange MVE 2015
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2015
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now