Msgbox Based on Cell Content ???

R

Ron

Hello all,

I’m in need of VBA assistance that may be a little over my head. I’ve
prowled the archives and attempted on my own to come up with a
solution but I’m getting nowhere. Appreciate any assistance.

I’m developing a macro that will validate a spreadsheet that must meet
PeopleSoft standards prior to uploading to PeopleSoft. One issue
remaining open is: Account number in column K and department ID in
column N. Should the account number in column K be within the range
of 100000 – 330000 and accounts 939001 and 939002 then corresponding
cell in column N or department ID must be blank. I’ve addressed this
range with If c.Offset(0, -3) <= 330000 Then c.ClearContents End If.
Please see complete Macro below.

Should the column K account numbers range from 400000 -799999 and
equal or greater than 940000 a department ID must be entered in column
N. I’m not sure how to alert the user that a dept ID must be
entered.

I think I've covered the first paragraph with the code below but, I'm
not sure how to proceede with the second paragraph. Would I use a
Msgbox or ??? Appreciate your assistance with this code. Thank you,
Ron

Sub ValDataN()
Dim c As Range
ActiveSheet.Unprotect
Range("E12").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 9).Select

For Each c In Selection
If Len(c.Value) > 6 Then
c.Interior.ColorIndex = 3
End If
If Len(c.Value) < 6 Then
c.Interior.ColorIndex = 3
End If
If Len(c.Value) = 0 Then
c.Interior.ColorIndex = 0
End If
If Len(c.Value) = 6 Then
c.Interior.ColorIndex = 0
End If

If c.Offset(0, -3) <= 330000 Then
c.ClearContents
End If

If c.Offset(0, -3) = 939001 Then
c.ClearContents
End If

If c.Offset(0, -3) = 939002 Then
c.ClearContents
End If

Next c
End Sub
 
D

Dave Peterson

I _think_ I understand:

Option Explicit
Sub ValDataN()
Dim myCell As Range
Dim myRng As Range
Dim LastRow As Long
Dim wks As Worksheet
Dim ErrStr As String
Dim HowManyErrors As Long

ErrStr = "Needs Dept ID"
Set wks = ActiveSheet

With wks
.Unprotect
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
Set myRng = .Range("N12", .Cells(LastRow, "N"))

For Each myCell In myRng.Cells
myCell.Interior.ColorIndex = xlNone
If Len(myCell.Value) <> 6 Then
myCell.Interior.ColorIndex = 3
End If

'Account number in column K and department ID in
'column N. Should the account number in column K be within the
'range
'of 100000 – 330000 and accounts 939001 and 939002 then
'corresponding
'cell in column N or department ID must be blank.
'
'Should the column K account numbers range from 400000 -799999 and
'equal or greater than 940000 a department ID must be entered in
'column
'N. I’m not sure how to alert the user that a dept ID must be
'entered.

Select Case myCell.Offset(0, -3).Value
Case 100000 To 330000, 939001 To 939002
myCell.ClearContents
Case 400000 To 799999, Is >= 940000
If myCell.Value = "" Then
myCell.Value = ErrStr
End If
End Select
Next myCell
.Protect
End With

HowManyErrors = Application.CountIf(myRng, ErrStr)
If HowManyErrors > 0 Then
MsgBox "Please fix: " & HowManyErrors & " records!" _
& vbLf & "Search for: " & ErrStr
End If

End Sub
 
R

Ron

I _think_ I understand:

Option Explicit
Sub ValDataN()
    Dim myCell As Range
    Dim myRng As Range
    Dim LastRow As Long
    Dim wks As Worksheet
    Dim ErrStr As String
    Dim HowManyErrors As Long

    ErrStr = "Needs Dept ID"
    Set wks = ActiveSheet

    With wks
        .Unprotect
        LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
        Set myRng = .Range("N12", .Cells(LastRow, "N"))

        For Each myCell In myRng.Cells
            myCell.Interior.ColorIndex = xlNone
            If Len(myCell.Value) <> 6 Then
                myCell.Interior.ColorIndex = 3
            End If

            'Account number in column K and department ID in
            'column N.  Should the account number in columnK be within the
            'range
            'of 100000 – 330000 and accounts 939001 and 939002 then
            'corresponding
            'cell in column N or department ID must be blank.
            '
            'Should the column K account numbers range from 400000 -799999 and
            'equal or greater than 940000 a department ID must be entered in
            'column
            'N.  I’m not sure how to alert the user that a dept ID must be
            'entered.

            Select Case myCell.Offset(0, -3).Value
                Case 100000 To 330000, 939001 To 939002
                    myCell.ClearContents
                Case 400000 To 799999, Is >= 940000
                    If myCell.Value = "" Then
                        myCell.Value = ErrStr
                    End If
            End Select
        Next myCell
        .Protect
    End With

    HowManyErrors = Application.CountIf(myRng, ErrStr)
    If HowManyErrors > 0 Then
        MsgBox "Please fix: " & HowManyErrors & " records!" _
                    & vbLf & "Search for: " & ErrStr
    End If

End Sub
















--

Dave Peterson- Hide quoted text -

- Show quoted text -
Click to expand...

Hi Dave, thank you. Wow! what a great interpretation This code is
hot.... only one problem. Works perfect first time through, however
When I run it a second time the code applys interior color to a blank
cell that is in case 100000 To 330000, 939001 To 939002. Deletes
Dept ID like it should, however if I run it again it will highlight
the blank cells created by case 1. Any suggestions? Thank you, Ron


The second case must have a Dept ID and that's working perfect

Select Case myCell.Offset(0, -3).Value
Case 100000 To 330000, 939001 To 939002
myCell.ClearContents
Case 400000 To 799999, Is >= 940000
If myCell.Value = "" Then
myCell.Value = ErrStr
End If
 
D

Dave Peterson

I missed that last colorindex in your original code:

Option Explicit
Sub ValDataN()
Dim myCell As Range
Dim myRng As Range
Dim LastRow As Long
Dim wks As Worksheet
Dim ErrStr As String
Dim HowManyErrors As Long

ErrStr = "Needs Dept ID"
Set wks = ActiveSheet

With wks
.Unprotect
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
Set myRng = .Range("N12", .Cells(LastRow, "N"))

For Each myCell In myRng.Cells
myCell.Interior.ColorIndex = xlNone
If Len(myCell.Value) > 0 _
And Len(myCell.Value) <> 6 Then
myCell.Interior.ColorIndex = 3
End If

Select Case myCell.Offset(0, -3).Value
Case 100000 To 330000, 939001 To 939002
myCell.ClearContents
Case 400000 To 799999, Is >= 940000
If myCell.Value = "" Then
myCell.Value = ErrStr
End If
End Select
Next myCell
.Protect
End With

HowManyErrors = Application.CountIf(myRng, ErrStr)
If HowManyErrors > 0 Then
MsgBox "Please fix: " & HowManyErrors & " records!" _
& vbLf & "Search for: " & ErrStr
End If
End Sub


Ron wrote:
 
R

Ron

I missed that last colorindex in your original code:

Option Explicit
Sub ValDataN()
    Dim myCell As Range
    Dim myRng As Range
    Dim LastRow As Long
    Dim wks As Worksheet
    Dim ErrStr As String
    Dim HowManyErrors As Long

    ErrStr = "Needs Dept ID"
    Set wks = ActiveSheet

    With wks
        .Unprotect
        LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
        Set myRng = .Range("N12", .Cells(LastRow, "N"))

        For Each myCell In myRng.Cells
            myCell.Interior.ColorIndex = xlNone
            If Len(myCell.Value) > 0 _
             And Len(myCell.Value) <> 6 Then
                myCell.Interior.ColorIndex = 3
            End If

            Select Case myCell.Offset(0, -3).Value
                Case 100000 To 330000, 939001 To 939002
                    myCell.ClearContents
                Case 400000 To 799999, Is >= 940000
                    If myCell.Value = "" Then
                        myCell.Value = ErrStr
                    End If
            End Select
        Next myCell
        .Protect
    End With

    HowManyErrors = Application.CountIf(myRng, ErrStr)
    If HowManyErrors > 0 Then
        MsgBox "Please fix: " & HowManyErrors & " records!" _
                    & vbLf & "Search for: " & ErrStr
    End If
End Sub

Ron wrote:

<<snipped>>








--

Dave Peterson- Hide quoted text -

- Show quoted text -
Click to expand...

Hi Dave, when I run it for the first time on a worksheet it finds
case 2 scnarios and adds Needs Dept ID, but does not color the cell
red. When I run it the second time it finds case 2 scnario and colors
them red. Any way to get it to color the cell red the first time
through. Other than that it works great and thank you for your
assistance and follow ups. Ron
 
D

Dave Peterson

How about:

Option Explicit
Sub ValDataN()
Dim myCell As Range
Dim myRng As Range
Dim LastRow As Long
Dim wks As Worksheet
Dim ErrStr As String
Dim HowManyErrors As Long

ErrStr = "Needs Dept ID"
Set wks = ActiveSheet

With wks
.Unprotect
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
Set myRng = .Range("N12", .Cells(LastRow, "N"))

'no colors to start in all the range
myRng.Interior.ColorIndex = xlNone

For Each myCell In myRng.Cells

If Len(myCell.Value) > 0 _
And Len(myCell.Value) <> 6 Then
myCell.Interior.ColorIndex = 3
End If

Select Case myCell.Offset(0, -3).Value
Case 100000 To 330000, 939001 To 939002
myCell.ClearContents
Case 400000 To 799999, Is >= 940000
If myCell.Value = "" Then
myCell.Value = ErrStr
myCell.Interior.ColorIndex = 3
End If
End Select
Next myCell
.Protect
End With

HowManyErrors = Application.CountIf(myRng, ErrStr)
If HowManyErrors > 0 Then
MsgBox "Please fix: " & HowManyErrors & " records!" _
& vbLf & "Search for: " & ErrStr
End If
End Sub

Ron wrote:
 
R

Ron

How about:

Option Explicit
Sub ValDataN()
    Dim myCell As Range
    Dim myRng As Range
    Dim LastRow As Long
    Dim wks As Worksheet
    Dim ErrStr As String
    Dim HowManyErrors As Long

    ErrStr = "Needs Dept ID"
    Set wks = ActiveSheet

    With wks
        .Unprotect
        LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
        Set myRng = .Range("N12", .Cells(LastRow, "N"))

        'no colors to start in all the range
        myRng.Interior.ColorIndex = xlNone

        For Each myCell In myRng.Cells

            If Len(myCell.Value) > 0 _
             And Len(myCell.Value) <> 6 Then
                myCell.Interior.ColorIndex = 3
            End If

            Select Case myCell.Offset(0, -3).Value
                Case 100000 To 330000, 939001 To 939002
                    myCell.ClearContents
                Case 400000 To 799999, Is >= 940000
                    If myCell.Value = "" Then
                        myCell.Value = ErrStr
                        myCell.Interior.ColorIndex = 3
                    End If
            End Select
        Next myCell
        .Protect
    End With

    HowManyErrors = Application.CountIf(myRng, ErrStr)
    If HowManyErrors > 0 Then
       MsgBox"Please fix: " & HowManyErrors & " records!" _
                    & vbLf & "Search for: " & ErrStr
    End If
End Sub

Ron wrote:

<<snipped>>
Click to expand...

Hi Dave, works perfect. Thank you for your assistance, wish I could
buy you a couple of beers. Thanks, Ron Smith
 
D

Dave Peterson

Glad it's working.

If you're going to hang around in these Microsoft excel newsgroups, you may have
noticed that most people are top posters (different than in most general
newsgroups).

You may want to start doing the same.
 
R

Ron

Glad it's working.

Ifyou're going to hang around in these Microsoft excel newsgroups, you may have
noticed that most people are top posters (different than in most general
newsgroups).

You may want to start doing the same.



Ron wrote:
Click to expand...

Hi Dave, I don't understand your reply. Am I doing something wrong?
Thanks, Ron
 
D

Dave Peterson

Nothing wrong--just something uncommon in these newsgroup.

Most people put their response at the top of the new message (Top posting). You
put your response at the bottom (bottom posting).
 
R

Ron

Is this better? Sorry, I've never paid attention. Thanks for the
heads up. Have a good one, Ron
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

"ElseIf c.Value = "X_Clear" Then" and "...Target.Cells.Count > 1"don't work 4
Copy row info but not in normal column sequence 6
Remove Identical words 0
Sheet to sheet code Type Mismatch 6
Value from one sheet paste under same value on other sheet. 7
Marco is not working 1
change cellvalue based on value in adjacent cell 5
Change_Event troubles, no error & no work. 6

Top