CODEWITHSUNDEEP
vbaexcel
Nobelium
Nobelium

Reputation: 53

Setting a default value for empty cells in excel vba

I have created an user form where an employee can enter his information. See table below:

    | A             | B            | C            |
5   |               | Empl. ID     |              |
6   |               |              |              |
7   |               | Empl. ID     |              |
8   |               | Last Name    |              |
9   |               | Date of B.   |              |
10  |               | Work         |              |
11  |               | Email        |              |
12  |               | Driving L.   |              |

In columns C, employee is requested to enter his information in the respective cells (C7:C12) and to press a button to store the data entry in another worksheet. In cell C5, there is a dropdown list with which employee is able to retrieve their data entry (by selecting their Empl. ID), in order to make changes.

Now, I want to add a default text in the entry form, if a cell is empty. I have the following code for this purpose:

Sub AddDefaultValue()
    With ThisWorkbook
        .Sheets("Entry Form").Range("C7:C48").Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.Replace What:="", Replacement:="Please enter your information.", _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=_
            False, ReplaceFormat:=False
        With Selection.Font
            .Color = -16776961
            .TintAndShade = 0
            .Bold = True
        End With
        Selection.Font.Bold = True
    End With
End Sub

I actually got what I wanted, however, when I retrieve data entries from the other worksheet, the format changes (red and bold). I just want the previously entered information to remain the same. Only if the cell is empty, I want the default text to be red and bold...

Another problem is that I have different format for cells (e.g. C9 is formatted as Date). As a consequence, the "button" to create a new entry doesn't work anymore. 

Option Explicit

'enables data entry via userform

'Declare variables
Type EntryDetails

   EmplID As String
   LastName As String
   DateOfBirth As Date
   Work As String
   Email As String
   DrivingLicense As Integer

End Type

Public EntryRecord As EntryDetails
Public EntryList(1 To 1000) As EntryDetails
Public TempEntryList As Variant
Public PrintEntryList(1 To 1000) As EntryDetails
'Public PrintEntryList(1 To 1000, 1 To 6) As EntryDetails

Sub EntryCreate_Controller()

'orchestrates all subs and functions 

    'retrieve entry list information
    Call get_EntryList
    'add new entry 
    Call get_NewEntry
        With EntryList(get_emptyRecord)
        .EmplID = EntryRecord.EmplID
        .LastName = EntryRecord.LastName
        .DateOfBirth = EntryRecord.DateOfBirth
        .Work = EntryRecord.Work
        .Email = EntryRecord.Email
        .DrivingLicense = EntryRecord.DrivingLicense
End With

        'display entry list
        'Call print_EntryList

End Sub

Function get_emptyRecord()
    Dim counter As Integer  
    For counter = 1 To UBound(EntryList)
        If EntryList(counter).EmplID = Empty Then
            get_emptyRecord = counter
            Exit For
        End If
    Next counter
End Function


Function get_EntryExists(EmplID As String) As Boolean
    Dim counter As Integer
    get_ProjectExists = False
    For counter = 1 To UBound(EntryList)
        If EntryList(counter).EmplID = Empty Then Exit For
        If EntryList(counter).EmplID = EmplID Then
            get_EntryExists = True
            Exit For
        End If
    Next counter
End Function

Function print_EntryList()
    Dim counter
    For counter = 1 To UBound(EntryList)
        If EntryList(counter).EmplID = Empty Then Exit Function
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 0).Value = EntryList(counter).EmplID
       If EntryList(counter).LastName <> "Please enter your information." Then
       Else
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 1).Value = EntryList(counter).LastName
       End If
       If EntryList(counter).DateOfBirth <> "Please enter your information." Then
       Else
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 2).Value = EntryList(counter).DateOfBirth
       End If
       If EntryList(counter).Work <> "Please enter your information." Then
       Else
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 3).Value = EntryList(counter).Work
       End If
       If EntryList(counter). Email <> "Please enter your information." Then
       Else
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 4).Value = EntryList(counter).Email
       End If
       If EntryList(counter). DrivingLicense <> "Please enter your information." Then
       Else
               Sheets("Data Entries").Range("EntryListStart").Offset(counter - 1, 5).Value = EntryList(counter).DrivingLicense
       End If
    End if
    Next counter
End Function

Function get_NewEntry()
    'initialize variables
    With EntryRecord
    .EmplID = Sheets("Entry Form").Range("Form_EmplID").Value
    .LastName = Sheets("Entry Form").Range("Form_LastName").Value
    .DateOfBirth = Sheets("Entry Form").Range("Form_DateOfBirth").Value
    .Work = Sheets("Entry Form").Range("Form_Work").Value
    .Email = Sheets("Entry Form").Range("Form_Email").Value
    .DrivingLicense = Sheets("Entry Form").Range("Form_DrivingLicense").Value
End With
End Function

Function get_EntryList()
TempEntryList = Sheets("Data Entries").Range("EntryListStart").Range("A1:F10000").Value
    Dim counter As Integer
    For counter = 1 To 1000
        If TempEntryList(counter, 1) = Empty Then Exit For
            With EntryList(counter)
            .EmplID = TempEntryList(counter, 1)
            .LastName = TempEntryList(counter, 2)
            .DateOfBirth = TempEntryList(counter, 3)
            .Work = TempEntryList(counter, 4)
            .Email= TempEntryList(counter, 5)
            .DrivingLicense = TempEntryList(counter, 6)
            End With
    Next counter

    get_EntryList = True
End Function

Upvotes: 0

Views: 3053

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

I suggest to use conditional formatting. So if the cells contain Please enter your information. they automatically get formatted red and bold and if the user enters something else then they get back to its previous format automatically.

Either you set the rule manually once and then use:

Option Explicit

Public Sub AddDefaultValue()
    With ThisWorkbook.Sheets("Entry Form").Range("C7:C48")   
        If Application.WorksheetFunction.CountBlank(.Cells) > 0 Then         
            .SpecialCells(xlCellTypeBlanks).Value = "Please enter your information."
        End If
    End With
End Sub

Or you set the condition with the code too:

Option Explicit

Public Sub AddDefaultValue()
    With ThisWorkbook.Sheets("Entry Form").Range("C7:C48")
        .FormatConditions.Delete

        With .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Please enter your information.""").Font
            .Bold = True
            .Color = -16776961
            .TintAndShade = 0
        End With

        If Application.WorksheetFunction.CountBlank(.Cells) > 0 Then
            .SpecialCells(xlCellTypeBlanks).Value = "Please enter your information."
        End If
    End With
End Sub

Additionally I recommend to read: How to avoid using Select in Excel VBA.

Upvotes: 0

Related Questions