VBA for excel....currentregion

[lobboroz]

Hi,
was wondering if anyone can help me with my problem
Im trying to write a vba code for excel application where the user enters an ID code and the code is entered into a column. Before the id is entered it searches through the column to see if the ID is already in use and if it is will display error msg. However right now im using match to search the column but its on a fixed range. code i used:

strId = InputBox(prompt:="Enter staff ID:", Title:="Staff ID&quot
strOffset = Application.WorksheetFunction.Match(strId, _
Range("a4:a15&quot, 0)
MsgBox ("Staff ID already exists!&quot

Because new ID are always entered the range cant be fixed. I tried using currentregion but kept getting errors. Can anyone help me with this?

Lobb

 

[simoncpage]

Try this Lobboroz................


This goes in the Workbook Object
---------------------------------
Private Sub Workbook_Open()

RunFirst

End Sub
---------------------------------


This goes in the Sheet1 Object
---------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Variant

If Target.Cells = Range("Ident&quot Then

For Each cell In Range("IdCol&quot

If cell.Value = Range("Ident&quot.Value Then
MsgBox "This Already Exist"

With Range("Ident&quot
.Font.ColorIndex = 3
.Select
End With

Exit Sub
Else
End If

Next cell

MsgBox "New Entry"
Range("IdCol&quot.Font.ColorIndex = 5


End If

RunFirst

End Sub
------------------------------------


And this goes into a module
-------------------------------------
Sub RunFirst()

ActiveWorkbook.Names.Add Name:="IdCol", _ RefersToR1C1:="=Sheet1!R1C1:R" & FindLast & "" & "C1"
ActiveWorkbook.Names.Add Name:="Ident", _ RefersToR1C1:="=Sheet1!R" & FindLast + 1 & "" & "C1"

End Sub

Function FindLast()

Dim maxrow As Integer, maxcolumn As Integer, cell As Variant

maxrow = 1
maxcolumn = 1

For Each cell In Intersect(Sheet1.Range("A:A&quot, Sheet1.UsedRange)
If cell.Text <> &quot;&quot; Then
If cell.Row > maxrow Then
maxrow = cell.Row
End If
If cell.Column > maxcolumn Then
maxcolumn = cell.Column
End If
End If
Next cell

FindLast = maxrow

End Function
-------------------------------------------

HTH?

Simon

 

[simoncpage]

I should also point out that this assumes that you have the IDs in the first column of the sheet starting topleft downwards and new entries are added at the bottom of each sheet? If the sheet is quite long and is usually opened to edit it might be worth adding....

Range(&quot;Ident&quot.Select

in the workbook open code so it goes straight to the bottom.

Simon

 

[rmikesmith]

Lobb,

The following should do what you want:

Sub EnterID()
Dim strID As String
Dim LastEntryAddress As String
Dim LookupRange As String
Dim MatchRange As Range
Dim Result As Variant

strID = InputBox(prompt:="Enter staff ID:", Title:="Staff ID")

LastEntryAddress = ActiveSheet.Cells(65536, 1).End(xlUp).Address
LookupRange = "$A$2:" & LastEntryAddress
Set MatchRange = ActiveSheet.Range(LookupRange)
Result = Application.Match(strID, MatchRange, 0)

If IsError(Result) Then
  ActiveSheet.Range(LastEntryAddress).Offset(1, 0).Value = strID
Else
  MsgBox "Staff ID already exists!", vbExclamation + vbOKOnly, "Staff ID"
End If

End Sub

Notes: The procedure assumes ID's are in column A with a heading in row 1. To have the Match function work properly, format the column containing ID's as Text before entering any data.

Regards,
M. Smith