VBA Code to find and apply formatting to specific text strings

**chozen86** · 07-21-2008, 04:16 PM

Hi all,

I am very new to the Macro and VBA "underworld" of Excel, and I have a (hopefully) simple procedural formatting task that I believe can be automated; I'm just not sure how.

The short way to explain what I need done is to refer you to the attached worksheet and say that I would like to write code to have excel apply formatting to the "raw" worksheet and make it look like the "formatted" worksheet.

The long way is to provide a detailed explanation of the 3 specific subgoals to this general formatting task:

1a) Find all cells containing the trial name (e.g., "Trial 2 Interruption nil") and 1b) Highlight all cells on the same row yellow

2a) Find all cells signaling the beginning of an interruption (e.g., "Interruption TQ begins"),
2b) Find all cells signaling the end of an interruption (e.g., "Interruption ends"), and
2c) Highlight all cells on the same rows as 2a and 2b and all cells on rows in between 2a and 2b light yellow

3a) Find all cells in column F containing the word "incorrect" and
3b) Highlight those cells red

The purpose of this reformatting task is to make a range of datasets more amenable to coding and analysis. Any help would be greatly appreciated.

**rylo** · 07-21-2008, 10:13 PM

Hi

See how this goes.

Sub eee()
'yellow for Trial items
  Set findit = Range("B:B").Find(what:="Trial", lookat:=xlPart)
  If Not findit Is Nothing Then
    firstadd = findit.Address
    Do
      findit.EntireRow.Interior.ColorIndex = 6
      Set findit = Range("B:B").Find(what:="Trial", lookat:=xlPart, after:=findit)
    Loop Until findit.Address = firstadd
  End If
  
  'pale yellow for Interruption
  Set findit = Range("B:B").Find(what:="Interruption TQ Begins", lookat:=xlPart)
  If Not findit Is Nothing Then
    firstadd = findit.Address
    Do
      i = -1
      Do
        i = i + 1
        findit.Offset(i, 0).EntireRow.Interior.ColorIndex = 36
        
      Loop Until Left(findit.Offset(i, 0).Value, 17) = "Interruption ends"
      Set findit = Range("B:B").Find(what:="Interruption * Begins", lookat:=xlPart, after:=findit)
    Loop Until findit.Address = firstadd
  End If
  
  'red for incorrect
  Set findit = Range("F:F").Find(what:="incorrect", lookat:=xlPart)
  If Not findit Is Nothing Then
    firstadd = findit.Address
    Do
      findit.Interior.ColorIndex = 3
      Set findit = Range("F:F").Find(what:="incorrect", lookat:=xlPart, after:=findit)
    Loop Until findit.Address = firstadd
  End If
  
  
  MsgBox "Done"
End Sub

rylo

**chozen86** · 07-22-2008, 12:27 AM

thanks so much!

how do you apply this code to an entire workbook?

**rylo** · 07-22-2008, 01:13 AM

Hi

Here goes.

Sub eee()
  For Each sh In ActiveWorkbook.Sheets
    sh.Activate
'yellow for Trial items
    Set findit = Range("B:B").Find(what:="Trial", lookat:=xlPart)
    If Not findit Is Nothing Then
      firstadd = findit.Address
      Do
        findit.EntireRow.Interior.ColorIndex = 6
        Set findit = Range("B:B").Find(what:="Trial", lookat:=xlPart, after:=findit)
      Loop Until findit.Address = firstadd
    End If
  
  'pale yellow for Interruption
    Set findit = Range("B:B").Find(what:="Interruption TQ Begins", lookat:=xlPart)
    If Not findit Is Nothing Then
      firstadd = findit.Address
      Do
        i = -1
        Do
          i = i + 1
          findit.Offset(i, 0).EntireRow.Interior.ColorIndex = 36
        Loop Until Left(findit.Offset(i, 0).Value, 17) = "Interruption ends"
        Set findit = Range("B:B").Find(what:="Interruption * Begins", lookat:=xlPart, after:=findit)
      Loop Until findit.Address = firstadd
    End If
  
  'red for incorrect
    Set findit = Range("F:F").Find(what:="incorrect", lookat:=xlPart)
    If Not findit Is Nothing Then
      firstadd = findit.Address
      Do
        findit.Interior.ColorIndex = 3
        Set findit = Range("F:F").Find(what:="incorrect", lookat:=xlPart, after:=findit)
      Loop Until findit.Address = firstadd
    End If
  Next sh
  
  MsgBox "Done"
End Sub

rylo