PDA

View Full Version : Excel Alarm/Alert Code



test1986
12-04-2006, 05:00 AM
Hi all,

I'm completely new to this forum so sorry if my comments dont make sense.

Ok i have the sheet which is attached. I want a piece of code to set up an alarm to tell me when there is a differentiation in some of the codes.

So i want it to look down column A which will look at the code and see if there is any other cells with this same code in column A. If there is i then want it to check the cell next to it in column B and see if there is a differentiation witht the prices. So if cell 56 has a code of 566.876 in column A and so does cell 108, but they both have different numbers in column B then i want an alarm to pop up and let me know or highlight the cells.

Hope this makes sense. Please let me know if it doesnt.

Cheers

mdmackillop
12-04-2006, 06:45 AM
Hi,
Welcome to VBAX.
I note some of your codes are preceded by an apostrophe, others are not. If your cells are formatted text, the apostrophe should not be required.
Try

Option Explicit
Sub Check()
Dim Rng As Range, chk As Variant, msg As Boolean, cel As Range, c As Range
Dim FirstAddress As String
Set Rng = Worksheets(1).Range(Cells(3, 1), Cells(Rows.Count, 1).End(xlUp))
msg = False
For Each cel In Rng
chk = cel.Offset(, 1)
With Rng
Set c = .Find(cel.Value, after:=cel, LookIn:=xlValues, searchdirection:=xlNext)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If c.Offset(, 1) <> chk Then
msg = True
cel.Resize(, 2).Interior.ColorIndex = 6
c.Resize(, 2).Interior.ColorIndex = 6
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Next
If msg = True Then
MsgBox "Discrepancies found.", vbInformation
Else
MsgBox "No discrepancies found.", vbInformation
End If
End Sub

test1986
12-04-2006, 06:57 AM
Thanks for the warm welcome.

You guys are such geniuses. That has worked first time round. Ive spent many hours trying to sort this out and i really appreciate your help. :cloud9:

Seen as your here could i just ask one more question (sorry),

I also need to scan down column A and see if there is any text within the cells or txt which says "POA" and if there is i then need to delete that entire row.

I have this code which does blanks:


OASh.Range("A3:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete (xlShiftUp)

Thanks for the help again.

lucas
12-04-2006, 08:55 AM
I also need to scan down column A and see if there is any text within the cells or txt which says "POA" and if there is i then need to delete that entire row.

delete if any text???? or POA???
this should delete the row if POA is in column A

Sub DeletePoa()
Dim test As Boolean, x As Long, lastrow As Long, col As Long
Range("A8").Select
col = ActiveCell.Column
lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1
test = Cells(x, col).Text Like "POA"
If test = True Then Cells(x, col).EntireRow.Delete
Next
End Sub

mdmackillop
12-04-2006, 10:11 AM
To delete any text

Sub DeleteText()
Dim x As Long
For x = Cells(Rows.Count, 1).End(xlUp).Row To 4 Step -1
If Not (IsNumeric(Cells(x, 1))) Then Cells(x, 1).EntireRow.Delete
Next
End Sub

test1986
12-05-2006, 01:14 AM
Dear All,

Both work wonders, as i said before i really appreciate all of your help. This has been one of the most usefull forums I have been on.

I also have another query and im sure its really easy but i keep trying to do it but with no success.

I want it to search column A and if there are less than 6 digits in the Numeric cell then i want to flag the whole row or cell in a highlighted colour.

Any Ideas would be much appreciated.

Cheers

mdmackillop
12-05-2006, 01:00 PM
Option Explicit
Sub TestFor6()
Dim cel As Range, MyStr As String
For Each cel In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
MyStr = Application.WorksheetFunction.Substitute(cel, ".", "")
If Len(MyStr) <> 6 Then cel.Interior.ColorIndex = 6
Next
End Sub