A1 is in green highlight A2 not green A3 not green A4 is in green highlight A5 n

Question

A1 is in green highlight

A2 not green

A3 not green

A4 is in green highlight

A5 not green

A6 not green

A7 is in green highlight

etc.

I need to determine if there are only two un-green highlighted cells after the one green highlighted cell.

If not (say only one cell -- not the required two) or three (or whatever combination), the macro should stop so editing can be done. Then the macro could start again to find the next problem. For example,

A7 is in green highlight

A8 not green

A9 not green

A20 not green

At this point the macro would stop.

I would deeply appreciate your help in this matter.

Anyone ???

Explanation / Answer

In that case, I believe either of the routines I've posted here would do the job for you. By checking for .Interior.ColorIndex against xlNone we don't have to worry exactly what shade of green you used, you could even change your mind later and use yellow, red, or whatever and it would still work.

You could keep the old code (which I've modified here a little to trap for empty cells where there should be 1 word), and then call the two individual routines in which ever sequence you want like this (use the CheckGreenCounts() from above).

Sub CheckBoth()

'swap the order to check in other sequence

Run "StrangeTranspose" ' check for 1-word-only process

Run "CheckGreenCounts"

End Sub

'the revised check for 1 word code

Sub StrangeTranspose()
Dim lastRow As Long
Dim rowPtr As Long
Dim testFor1Word As String

lastRow = Range("A" & Rows.Count).End(xlUp).Row
'we will work in 3-row groups, testing A1, A4, A7 etc
'for just 1 word to the last row used
For rowPtr = 1 To lastRow Step 3
    testFor1Word = Trim(Range("A" & rowPtr))
    If InStr(testFor1Word, " ") > 0 _
     Or Len(Trim(testFor1Word)) = 0 Then
      'has space character, indicating more than 1 word
      ' or has no word at all!
      MsgBox "Stopped processing at cell " & "A" & rowPtr, _
       vbOKOnly + vbExclamation, "Incorrect Word Count"
      Application.Goto Range("A" & rowPtr)
      Exit Sub ' stops at first mistake
    End If
    'move next row's data to column B
    'but only if it is not an empty cell
    If Not IsEmpty(Range("A" & rowPtr + 1)) Then
      Range("B" & rowPtr) = Range("A" & rowPtr + 1)
      'clear this entry in column A
      Range("A" & rowPtr + 1).ClearContents
    End If
    'do same thing for 2 rows down, but to column C
    If Not IsEmpty(Range("A" & rowPtr + 2)) Then
      Range("C" & rowPtr) = Range("A" & rowPtr + 2)
      'clear this entry in column A
      Range("A" & rowPtr + 2).ClearContents
    End If
Next ' end rowPtr loop
End Sub

Related Questions

Navigate

• Browse (All)
• Browse A
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.