Highlighting rows inside first empty cell loop

[DrPepper]

Help!!! I have a row highlighting issue.

I have two worksheet, "Sign-in" and "Data". On Sign-in, I have a button created that launches a userform. This userform will put the information the user enters, into the Data worksheet. Value 7 is me.NewPet.Value, which is a checkbox, if the pet is new.

If the pet is new I need the whole row, in the Data worksheet, to be the color Red.

My problem is: I can't use activecell, since I'm searching for the first empty cell. How can I color the row within the "first empty row" search?

[vba]
Private Sub AddPet_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'copy the data to the database
ws.Cells(iRow, 1).Value = Me.Date1.Value
ws.Cells(iRow, 2).Value = Me.PetName.Value
ws.Cells(iRow, 3).Value = Me.OwnerName.Value
ws.Cells(iRow, 4).Value = Me.FromDate.Value
ws.Cells(iRow, 5).Value = Me.ToDate.Value
ws.Cells(iRow, 6).Value = Me.Phone.Value
ws.Cells(iRow, 7).Value = Me.NewPet.Value
ws.Cells(iRow, 8).Value = Me.Shots_Need.Value
ws.Cells(iRow, 9).Value = Me.Comments.Value

'color entire row Red if "Yes" is checked for NewPet.
If Me.NewPet.Value = True Then
With ActiveCell.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

Else
ws.Cells(iRow, 7).Value = ""
End If

'color entire row Yellow if "Needed" is checked for Shots_Need
If Me.Shots_Need.Value = True Then
With ActiveCell.Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
ws.Cells(iRow, 8).Value = "Up To Date"
End If


'clear the data
Me.Date1.Value = ""
Me.PetName.Value = ""
Me.OwnerName.Value = ""
Me.FromDate.Value = ""
Me.ToDate.Value = ""
Me.Phone.Value = ""
Me.NewPet.Value = ""
Me.Shots_Need.Value = ""
Me.Comments.Value = ""
Me.Date1.SetFocus
End Sub
[/vba]
Thanks in advance for the help.
Dr Pepper

[mdmackillop]

Hi Dr P
Welcome to VBAX
Can you post your workbook? Use Manage Attachments in the Go Advanced reply section.

2 admin points.
You can format posted code as shown using the green VBA button.
Please don't post your email address unless you really enjoy receiving spam!

Regards
MD

[DrPepper]

Sure... I'll do that right away... Thanks...

[DrPepper]

Here's the file...

[mdmackillop]

Try this.
[VBA]
Private Sub AddPet_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
'check for a date
If Trim(Me.Date1.Value) = "" Then
Me.Date1.SetFocus
MsgBox "Please enter a Date"
Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = Me.Date1.Value
ws.Cells(iRow, 2).Value = Me.PetName.Value
ws.Cells(iRow, 3).Value = Me.OwnerName.Value
ws.Cells(iRow, 4).Value = Me.FromDate.Value
ws.Cells(iRow, 5).Value = Me.ToDate.Value
ws.Cells(iRow, 6).Value = Me.Phone.Value
ws.Cells(iRow, 7).Value = Me.NewPet.Value
ws.Cells(iRow, 8).Value = Me.Shots_Need.Value
ws.Cells(iRow, 9).Value = Me.Comments.Value
'Colour New Pet row Red
If Me.NewPet.Value = True Then
ws.Cells(iRow, 1).Resize(, 10).Interior.ColorIndex = 3
End If
'Colour Shots row Yellow
If Me.Shots_Need.Value = True Then
ws.Cells(iRow, 1).Resize(, 10).Interior.ColorIndex = 6
Else
ws.Cells(iRow, 8).Value = "Up To Date"
End If


'clear the data
Me.Date1.Value = ""
Me.PetName.Value = ""
Me.OwnerName.Value = ""
Me.FromDate.Value = ""
Me.ToDate.Value = ""
Me.Phone.Value = ""
Me.NewPet.Value = False
Me.Shots_Need.Value = False
Me.Comments.Value = ""
Me.Date1.SetFocus
End Sub

[/VBA]

[DrPepper]

Thanks sooooo much! It worked great...

Just one other question... same program... if I click the "Yes" box, it enters the word "True" on the Data page instead of the word "Yes"... why is that? And how do I fix that to say "Yes"?

Same for the word "Need", but the fix should be the same for both...

[mdmackillop]

[VBA]
'copy the data to the database
With ws
.Cells(iRow, 1).Value = Me.Date1.Value
.Cells(iRow, 2).Value = Me.PetName.Value
.Cells(iRow, 3).Value = Me.OwnerName.Value
.Cells(iRow, 4).Value = Me.FromDate.Value
.Cells(iRow, 5).Value = Me.ToDate.Value
.Cells(iRow, 6).Value = Me.Phone.Value
.Cells(iRow, 9).Value = Me.Comments.Value
'Colour New Pet row Red
If Me.NewPet Then
.Cells(iRow, 7) = "Yes"
.Cells(iRow, 1).Resize(, 10).Interior.ColorIndex = 3
End If
'Colour Shots row Yellow
If Me.Shots_Need Then
.Cells(iRow, 8) = "Yes"
.Cells(iRow, 1).Resize(, 10).Interior.ColorIndex = 6
Else
.Cells(iRow, 8).Value = "Up To Date"
End If
End With

'clear the data
[/VBA]