Macro to check if cell is empty 4

[ljhaley]

I am trying to automate a process and am not having the best of luck. I need a macro to begin in a column and go down cell by cell until it finds a certain value. (this part I can do) Then I need it to go over (in the row of the cell with the value) and verify that four cells are not empty. If they are empty I need it to prompt or change the color of the cell. Something that would let me know that it needs to be filled in.

HELP!!!!

 

[VulcanJedi]

Sub tranpkp()

mycol = 1 '(assume your column is A1)
' find maxrows (various methods to find last row apparently you know how)

For recs = 1 To 20

If Cells(recs, mycol) = 5 Then 'your condition instead of 5
t = Application.WorksheetFunction.CountBlank(Range("B" & recs & ":E" & recs))
If t = 4 Then
Range("B" & recs & ":E" & recs).Interior.ColorIndex = 4
End If
End If

Next recs
End Sub Tranpkp
************************************
- Let me know if this helped/worked!
Remember to give helpful posts the stars they deserve, this facilitates others navigating through the threads / posts!

 

[ljhaley]

Sorry I didn't make it very clear that I need to check four specific cells to see if they are empty.

EX:
I will search column CY for cells that meet my criteria and
If the cell CY39 meets the criteria then I need to check X39:AA39 to see if they are empty. Then I need to mark them in some way.

Thank you for helping

 

[VulcanJedi]

simple code revision


Sub tranpkp()
mycol = 1 '(assume your column is A1)
' find maxrows (various methods to find last row apparently you know how)
Counter = 0
For recs = 1 To maxrows

If Range("CY" & recs) = 5 Then 'your condition instead of 5
t = Application.WorksheetFunction.CountBlank(Range("X" & recs & ":AA" & recs))
If t = 4 Then
Range("X" & recs & ":AA" & recs).Interior.ColorIndex = 4
End If
Counter = Counter + 1
End If

Next recs

If Counter > 0 Then MsgBox ("You encountered " & Counter & " values that need reviewing&quot
End Sub
Tranpkp

 

[DaleWatson123321]

Here's one method... Just change the column offset numbers to match with the columns you want to check for being blank.

Sub Set_Color()
'<<<Insert Your Routine Here>>>
Application.ScreenUpdating = False
curcell = ActiveCell.Address

If Range(curcell).Offset(0, 2).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, 2).Select
Color_Yellow
End If

If Range(curcell).Offset(0, 3).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, 3).Select
Color_Yellow
End If

If Range(curcell).Offset(0, 4).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, 4).Select
Color_Yellow
End If

Range(curcell).Select
Application.ScreenUpdating = True
End Sub

Sub Color_Yellow()
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End Sub

I hope this helps. Please advise as to how this fits.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

 

[VulcanJedi]

Dale -How are you sir?, couldn't your code be:

much shorter and really same as above, I guess I didn't see much difference except that you utilize the activecell/offset ? Did I miss any other differences/(advantages?)

Sub Set_Color()
'<<<Insert Your Routine Here>>>
Application.ScreenUpdating = False
curcell = ActiveCell.Address

for x = 2 to 4
If Range(curcell).Offset(0, x).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, 2).interior.colorindex = 6

End If
next x

Application.ScreenUpdating = True
End Sub



Tranpkp

 

[DaleWatson123321]

Hi Tranpkp,

I'm &quot;just great&quot; - thanks for asking

When I started writing my response, there hadn't yet been any postings. (Perhaps you either &quot;type faster&quot; or I might have had interruptions.)

As for my method, I intentionally used &quot;separate&quot; offsets because I anticipated the user might have a situation where the cells are NOT CONSECUTIVE. (In the initial posting, the user did not specify that the cells were consecutive.)

I don't mean to be critical, but just want the user to understand that in your modified version of my example, there appears to be an error - concerning the offset for colorcell.

for x = 2 to 4
If Range(curcell).Offset(0, x).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, 2).interior.colorindex = 6
End If
Next x

i.e. the line for colorcell should (also) be: .Offset(0, x) - not (0, 2)

As for the separate subroutine for the color and pattern fill options, I wanted to demonstrate the use of a separate subroutine where ADDITIONAL fill options can be used.

I hope this helps clarify some of my &quot;logic&quot;.

There are undoubtedly many areas where your VBA skills &quot;outshine&quot; mine ...as I've noticed in some of your other postings ...so I'll keep looking and learning.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

 

[ljhaley]

Thank you guys so much. The code works but now I am getteing an error when there are no more cells that match my criteria. I tried to use error handling and it works to an extent but I have to push the OK button about 10 times.

Here is my code:


Sub Find()

Columns(&quot;CY:CY&quot.Select
On Error GoTo ErrorHandler
Selection.Find(What:=&quot;.2&quot;, After:=ACTIVECELL, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ACTIVECELL.replace What:=&quot;.2&quot;, Replacement:=&quot; &quot;, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Set_Color

ErrorHandler:
MsgBox &quot;There are no more changes&quot;, vbOKOnly, &quot;THE END!&quot;
Exit Sub

End Sub



Sub Set_Color()

Application.ScreenUpdating = False
curcell = ACTIVECELL.ADDRESS

If Range(curcell).Offset(0, -76).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, -76).Select
Color_Yellow
End If

If Range(curcell).Offset(0, -77).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, -77).Select
Color_Yellow
End If

If Range(curcell).Offset(0, -78).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, -78).Select
Color_Yellow
End If

If Range(curcell).Offset(0, -79).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, -79).Select
Color_Yellow
End If

Range(curcell).Select
Find
Application.ScreenUpdating = True
End Sub

Sub Color_Yellow()
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End Sub

 

[DaleWatson123321]

ljhaley,

I've modified your code as follows. I believe you'll be pleased with the results.

Sub Find()
Get_BottomRow

Do
Columns(&quot;CY:CY&quot.Select
On Error GoTo ErrorHandler
Selection.Find(What:=&quot;.2&quot;, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell.Replace What:=&quot;.2&quot;, Replacement:=&quot; &quot;, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Set_Color

If currow > botmrow Then
Range(&quot;CY1&quot.Select
MsgBox &quot;There are no more changes&quot;, vbOKOnly, &quot;THE END!&quot;
Exit Sub
End If

Loop

ErrorHandler:

MsgBox &quot;There are no more changes&quot;, vbOKOnly, &quot;THE END!&quot;
Range(&quot;CY1&quot.Select
Exit Sub

End Sub

Sub Set_Color()

Application.ScreenUpdating = False
curcell = ActiveCell.Address
currow = ActiveCell.Row

If Range(curcell).Offset(0, -76).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, -76).Select
Color_Yellow
End If

If Range(curcell).Offset(0, -77).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, -77).Select
Color_Yellow
End If

If Range(curcell).Offset(0, -78).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, -78).Select
Color_Yellow
End If

If Range(curcell).Offset(0, -79).Value = &quot;&quot; Then
colorcell = Range(curcell).Offset(0, -79).Select
Color_Yellow
End If

Range(curcell).Select

End Sub

Sub Color_Yellow()
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End Sub

Sub Get_BottomRow()
Range(&quot;CY1&quot.Select
curcolm = ActiveCell.Column
botmrow = Cells(65536, curcolm).End(xlUp).Row
End Sub

I hope this works to your satisfaction. Please advise as to how it fits.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

 

[ljhaley]

Thank you so much. I do pretty well with VB but this is just different enough to confuse me. My boss does this kind of stuff all of the time and I think he just assumes that everyone else knows how.

Thanks again to DaleWatson and Tranpkp for all of your help!

 

[VulcanJedi]

I think I lost sight of what you wanted, I thought I had it I guess....beaten by Dale again?! I concede my master..argh Star for you. Tranpkp

 

[lespaul]

You both rock!! Stars all around! Leslie
landrews@metrocourt.state.nm.us

SELECT * FROM USERS WHERE CLUE > 0
No Rows Returned