Generating values in number of cells based on adjacent cell values

Any help on this ?

Hi subby,

Try the following code (tested in Excel 2003):

Option Explicit

Sub RequestID()

  Const sSerialNumberCOLUMN = "A"
  Const sDateCOLUMN = "B"
  Const sEngineerCOLUMN = "I"

  Dim rng As Range
  
  Dim mySpreadSheetDate As Date
  
  Dim iCount As Long
  Dim iHighestSerialNumber As Long
  Dim iLastRow As Long
  Dim iRow As Long
  
  Dim sEngineer As String
  Dim sExistingSerialNumber As String
  Dim sUserName As String
  Dim sValue As String
  
  'Get the User Name
  sUserName = GetUserNameFromEnvironmentVariable()
  
  'Get the last row used
  iLastRow = Range("a" & Rows.Count).End(xlUp).Row
  
  'Get the last row used (more reliable)
  iLastRow = Range("A1").SpecialCells(xlCellTypeLastCell).Row
  
  'Get the highest existing Serial Number (in Column 'A')
  Set rng = ActiveSheet.UsedRange.Columns(sSerialNumberCOLUMN).SpecialCells(xlConstants)
  iHighestSerialNumber = Application.WorksheetFunction.Max(rng)
  
  For iRow = 3 To iLastRow
       
    'Get the existing Serial Number from the Spreadsheet
    'Get the Date from the Spreadsheet
    'Get the Engineer Name from the spreadsheet
    'NOTE: Trim() function removes leading and trailing spaces
    sExistingSerialNumber = Trim(Cells(iRow, sSerialNumberCOLUMN).Text)
    sEngineer = Trim(Cells(iRow, sEngineerCOLUMN).Text)
  
    sValue = Cells(iRow, sDateCOLUMN).Text
    If IsDate(sValue) Then
      mySpreadSheetDate = CDate(sValue)
    Else
      mySpreadSheetDate = 0  'Set date to sentinel day (a long long time ago)
    End If
  
    'Put in a new serial number if
    'a. There is NO existing 'Serial Number' and
    'b. The date in the spreadsheet is today's date and
    'c. The User Name is the User Name on this computer
    If Len(sExistingSerialNumber) = 0 Then
      If mySpreadSheetDate = Date And UCase(sEngineer) = UCase(sUserName) Then
        iCount = iCount + 1
        iHighestSerialNumber = iHighestSerialNumber + 1
        Cells(iRow, sSerialNumberCOLUMN) = iHighestSerialNumber
      End If
    End If
    
  Next iRow
  
  MsgBox iCount & " New Serial Number(s) were added." & vbCrLf & _
         "The largest Serial Number is now " & iHighestSerialNumber & "."
  
End Sub

Public Function GetUserNameFromEnvironmentVariable()
    GetUserNameFromEnvironmentVariable = Environ$("UserName")
End Function

Lewis

Lewis, I haven't tried this code yet but i would like to thank you a lot for your dedication. I thought this would be as simple as just 4 lines...but you must have taken a lot of time to write this up and test it

Appreciate your help

Worked well... appreciate it....