Developer Code

LOGIN AND REGISTRATION CODES

REGISTRATION.PHP

This is the English version of the registration form for the private website. It works with validation.php file.

<?php
/* =========================================================
   Registration.php  (ENGLISH)
   Includes Show Password option
   ========================================================= */
?>
<!DOCTYPE HTML>
<html>
<head>
<title>Registration for the Private Website</title>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">

<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css">
<script src="https://www.google.com/recaptcha/api.js" async defer></script>

<style>
body { padding:40px; }
.section-box { border:3px solid rgb(225,225,255); padding:15px; margin-bottom:15px; }
</style>

<script>
function togglePassword() {
    var pw = document.getElementById("passwordField");
    if (pw.type === "password") {
        pw.type = "text";
    } else {
        pw.type = "password";
    }
}
</script>

</head>

<body>

<div class="container">
<h4 id="h_registration">Registration</h4>

<form method="post" action="validation.php">

<input type="hidden" name="lang" value="en">

<div class="row">
<div class="col-sm-6 section-box">
<label>First Name *</label>
<input class="form-control" type="text" name="firstname" required>
</div>

<div class="col-sm-6 section-box">
<label>Surname *</label>
<input class="form-control" type="text" name="surname" required>
</div>
</div>

<div class="row">
<div class="col-sm-6 section-box">
<label>Email *</label>
<input class="form-control" type="email" name="email" required>
</div>

<div class="col-sm-6 section-box">
<label>Username *</label>
<input class="form-control" type="text" name="username" required>
<div>Usernames cannot contain spaces.</div>
</div>
</div>

<div class="section-box">
<label>Password *</label>

<p>
Minimum 8 characters including upper-case,
lower-case and number.
</p>

<input class="form-control" type="password" id="passwordField" name="password" required>

<div style="margin-top:10px;">
<label>
<input type="checkbox" onclick="togglePassword()"> Show Password
</label>
</div>

</div>

<div class="row">
<div class="col-sm-6 section-box">
<label>Are you Macanese? *</label><br>
<label><input type="radio" name="macanese" value="Yes" required> Yes</label>
<label><input type="radio" name="macanese" value="No"> No</label>
</div>

<div class="col-sm-6 section-box">
<label>Is your spouse Macanese? *</label><br>
<label><input type="radio" name="spouse" value="Yes" required> Yes</label>
<label><input type="radio" name="spouse" value="No"> No</label>
</div>
</div>

<div class="section-box">
<label>If you are not already in the database, do you want to be included? *</label><br>
<label><input type="radio" name="database" value="Yes" required> Yes</label>
<label><input type="radio" name="database" value="No"> No</label>
</div>

<div class="section-box">
<label>Macanese parent(s) *</label>
<input class="form-control" type="text" name="parents" required>
</div>

<div class="section-box">
<label>Macanese grandparent(s) *</label>
<input class="form-control" type="text" name="grandparents" required>
</div>

<div class="section-box">
<label>Comments</label>
<p class="form-control" name="comments" rows="3"></p>
</div>

<div style="margin-top:20px;">
<div class="g-recaptcha" data-sitekey="6LdQsnMsAAAAAPYTNmWEk3PMNItZ07XWdLud0pDJ"></div>
</div>

<div style="margin-top:20px;">
<input class="btn btn-primary" type="submit" value="Submit">
</div>

</form>
</div>

</body>
</html>

REGISTO.PHP

This is the Portuguese version of the registration form for the private website. It works with validation.php file.

<?php
/* =========================================================
   Registo.php  (PORTUGUESE)
   Posts to validation.php
   ========================================================= */
?>
<!DOCTYPE HTML>
<html>
<head>
<title>Registo para o Website Privado</title>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">

<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css">
<script src="https://www.google.com/recaptcha/api.js" async defer></script>

<style>
body { padding:40px; }
.section-box { border:3px solid rgb(225,225,255); padding:15px; margin-bottom:15px; }
</style>

<script>
function togglePassword() {
    var pw = document.getElementById("passwordField");
    if (pw.type === "password") {
        pw.type = "text";
    } else {
        pw.type = "password";
    }
}
</script>

</head>

<body>

<div class="container">
<h4 id="h_registo">Registo</h4>

<form method="post" action="validation.php">

<input type="hidden" name="lang" value="pt">

<div class="row">
<div class="col-sm-6 section-box">
<label>Nome prÃ³prio *</label>
<input class="form-control" type="text" name="firstname" required>
</div>

<div class="col-sm-6 section-box">
<label>Apelido *</label>
<input class="form-control" type="text" name="surname" required>
</div>
</div>

<div class="row">
<div class="col-sm-6 section-box">
<label>Email *</label>
<input class="form-control" type="email" name="email" required>
</div>

<div class="col-sm-6 section-box">
<label>Nome de utilizador *</label>
<input class="form-control" type="text" name="username" required>
<div>O nome de utilizador nÃ£o pode conter espaÃ§os.</div>
</div>
</div>

<div class="section-box">
<label>Palavra-passe *</label>

<p>
MÃnimo de 8 caracteres, incluindo
uma letra maiÃºscula,
uma letra minÃºscula
e um nÃºmero.
</p>

<input class="form-control" type="password" id="passwordField" name="password" required>

<div style="margin-top:10px;">
<label>
<input type="checkbox" onclick="togglePassword()"> Mostrar palavra-passe
</label>
</div>

</div>

<div class="row">
<div class="col-sm-6 section-box">
<label>Ã macaense? *</label><br>
<label><input type="radio" name="macanese" value="Yes" required> Sim</label>
<label><input type="radio" name="macanese" value="No"> NÃ£o</label>
</div>

<div class="col-sm-6 section-box">
<label>O seu cÃ´njuge Ã© macaense? *</label><br>
<label><input type="radio" name="spouse" value="Yes" required> Sim</label>
<label><input type="radio" name="spouse" value="No"> NÃ£o</label>
</div>
</div>

<div class="section-box">
<label>Se ainda nÃ£o estiver na base de dados, deseja ser incluÃdo? *</label><br>
<label><input type="radio" name="database" value="Yes" required> Sim</label>
<label><input type="radio" name="database" value="No"> NÃ£o</label>
</div>

<div class="section-box">
<label>Nome(s) dos pais macaenses *</label>
<input class="form-control" type="text" name="parents" required>
</div>

<div class="section-box">
<label>Nome(s) dos avÃ³s macaenses *</label>
<input class="form-control" type="text" name="grandparents" required>
</div>

<div class="section-box">
<label>ComentÃ¡rios</label>
<p class="form-control" name="comments" rows="3"></p>
</div>

<div style="margin-top:20px;">
<div class="g-recaptcha" data-sitekey="6LdQsnMsAAAAAPYTNmWEk3PMNItZ07XWdLud0pDJ"></div>
</div>

<div style="margin-top:20px;">
<input class="btn btn-primary" type="submit" value="Submeter">
</div>

</form>
</div>

</body>
</html>

VALIDATION.PHP

This file checks submissions to the private website (both the English and Portuguese versions) and emails submissions out to selected addressees.

<?php
header('Content-Type: text/html; charset=utf-8');

/* =========================================================
   validation.php
   MINIMAL-CHANGE VERSION
   WHAT THIS DOES
   - Keeps the original working structure as closely as possible
   - Processes both English and Portuguese forms
   - Validates required fields
   - Validates email format
   - Validates password strength
   - Verifies Google reCAPTCHA
   - Sends HTML email to admin recipients
   - Minimal header tidy-up:
       * better From header
       * safe Reply-To
   ========================================================= */

/* ==============================
   CONFIG - CHANGE ONLY BELOW
   ============================== */

$recaptcha_secret = "6LdQsnMsAAAAALoJ139HgoKALvVdnZ_OEs94xv_x";

$admin_emails = array(
    "hda17@bigpond.com",
    "m_roliz@yahoo.com",
    "dassumpcao@ozemail.com.au"
);

/* ==============================
   MUST BE POST
   ============================== */

if ($_SERVER["REQUEST_METHOD"] !== "POST") {
    exit("Invalid access.");
}

/* ==============================
   COLLECT DATA
   ============================== */

$firstname    = trim($_POST['firstname'] ?? '');
$surname      = trim($_POST['surname'] ?? '');
$email        = trim($_POST['email'] ?? '');
$username     = trim($_POST['username'] ?? '');
$password     = trim($_POST['password'] ?? '');
$macanese     = $_POST['macanese'] ?? '';
$spouse       = $_POST['spouse'] ?? '';
$database     = $_POST['database'] ?? '';
$parents      = trim($_POST['parents'] ?? '');
$grandparents = trim($_POST['grandparents'] ?? '');
$comments     = trim($_POST['comments'] ?? '');
$captcha      = $_POST['g-recaptcha-response'] ?? '';
$lang         = trim($_POST['lang'] ?? 'en');

/* ==============================
   REQUIRED FIELD CHECK
   ============================== */

if (
    empty($firstname) ||
    empty($surname) ||
    empty($email) ||
    empty($username) ||
    empty($password) ||
    empty($macanese) ||
    empty($spouse) ||
    empty($database) ||
    empty($parents) ||
    empty($grandparents)
) {
    exit("Please complete required fields.");
}

/* ==============================
   EMAIL VALIDATION
   ============================== */

if (!filter_var($email, FILTER_VALIDATE_EMAIL)) {
    exit("Invalid email address.");
}

/* ==============================
   PASSWORD STRENGTH CHECK
   ============================== */

if (
    strlen($password) < 8 ||
    !preg_match("/[A-Z]/", $password) ||
    !preg_match("/[a-z]/", $password) ||
    !preg_match("/[0-9]/", $password)
) {
    exit("Password must be at least 8 characters and include upper-case, lower-case and a number.");
}

/* ==============================
   CAPTCHA CHECK
   ============================== */

if (empty($captcha)) {
    exit("Captcha not completed.");
}

$verify_url = "https://www.google.com/recaptcha/api/siteverify";
$response = @file_get_contents($verify_url . "?secret=" . urlencode($recaptcha_secret) . "&response=" . urlencode($captcha));
$captcha_success = json_decode($response);

if (!$captcha_success || empty($captcha_success->success)) {
    exit("Captcha verification failed.");
}

/* ==============================
   SANITISE
   ============================== */

function strip_crlf($s) {
    return str_replace(array("\r\n", "\r", "\n"), "", (string)$s);
}

$firstname    = strip_crlf($firstname);
$surname      = strip_crlf($surname);
$email        = strip_crlf($email);
$username     = strip_crlf($username);
$password     = strip_crlf($password);
$macanese     = strip_crlf($macanese);
$spouse       = strip_crlf($spouse);
$database     = strip_crlf($database);
$parents      = strip_crlf($parents);
$grandparents = strip_crlf($grandparents);

function h($s) {
    return htmlspecialchars((string)$s, ENT_QUOTES | ENT_SUBSTITUTE, 'UTF-8');
}

function email_no_autolink($email) {
    $safe = htmlspecialchars((string)$email, ENT_QUOTES | ENT_SUBSTITUTE, 'UTF-8');
    return str_replace('@', '@', $safe);
}

/* ==============================
   SUBJECT / TEXT BY LANGUAGE
   ============================== */

if ($lang === 'pt') {
    $subject = "Novo pedido de registo - Macanese Families";
    $thank_you_heading = "Obrigado";
    $thank_you_message = "O seu pedido de registo foi submetido.";
    $return_page = "Registo.php";
    $return_text = "Voltar ao formulário";
    $intro_text = "Novo pedido de registo:";
} else {
    $subject = "New Macanese Families Registration";
    $thank_you_heading = "Thank you";
    $thank_you_message = "Your registration request has been submitted.";
    $return_page = "Registration.php";
    $return_text = "Return to form";
    $intro_text = "New registration request:";
}

$encoded_subject = "=?UTF-8?B?" . base64_encode($subject) . "?=";

/* ==============================
   EMAIL BODY
   ============================== */

$rows = array(
    "First Name"           => $firstname,
    "Surname"              => $surname,
    "Email"                => $email,
    "Username"             => $username,
    "Password"             => $password,
    "Macanese"             => $macanese,
    "Spouse Macanese"      => $spouse,
    "Include in database"  => $database,
    "Parents"              => $parents,
    "Grandparents"         => $grandparents,
    "Comments"             => $comments
);

$body  = "<!doctype html><html><body>";
$body .= "<p><strong>" . h($intro_text) . "</strong></p>";
$body .= "<table cellpadding='6' cellspacing='0' style='font-family:Arial, sans-serif; font-size:14px;'>";

foreach ($rows as $field => $value) {

    if ($field === "Email") {
        $value_html = email_no_autolink($value);
    } else {
        $value_html = h($value);
    }

    if ($field === "Comments") {
        $value_html = nl2br($value_html);
    }

    $body .= "<tr>";
    $body .= "<td style='padding-right:15px;'><strong>" . h($field) . "</strong></td>";
    $body .= "<td>" . ($value_html === "" ? " " : $value_html) . "</td>";
    $body .= "</tr>";
}

$body .= "</table>";
$body .= "</body></html>";

/* ==============================
   HEADERS
   MINIMAL CHANGE FROM ORIGINAL
   ============================== */

/*
   WHAT CHANGED
   - The original file used:
       From: no-reply@macanesefamilies.org
       Reply-To: $email

   This version keeps the same simple approach,
   but changes From to a clearer named sender.
*/

$headers  = "MIME-Version: 1.0\r\n";
$headers .= "Content-Type: text/html; charset=UTF-8\r\n";
$headers .= "Content-Transfer-Encoding: 8bit\r\n";
$headers .= "From: Macanese Families Registration <registration@macanesefamilies.org>\r\n";
$headers .= "Reply-To: " . strip_crlf($email) . "\r\n";

/* ==============================
   SEND EMAILS
   ============================== */

foreach ($admin_emails as $admin_email) {
    mail($admin_email, $encoded_subject, $body, $headers);
}

/* ==============================
   OUTPUT
   ============================== */

echo "<h4 id="h_hthank_you_heading">" . h($thank_you_heading) . "</h4>";
echo "<p>" . h($thank_you_message) . "</p>";
echo "<p><a href='" . h($return_page) . "'>" . h($return_text) . "</a></p>";

exit;
?>

REDIRECT TO REGISTRATION/LOGIN FORM

This is used to redirect visitors who login to the old registration form to the new form.

<!DOCTYPE html>
<html lang="en">
<head>
  <meta charset="UTF-8">
  <meta http-equiv="refresh" content="0; url=https://macaneseheritage.org/login/?lang=en">
  <title>Redirecting...</title>
  <script>
    window.location.replace("https://macaneseheritage.org/login/?lang=en");
  </script>
</head>
<body>
  <p>Redirecting to the login page...</p>
  <p>If nothing happens, <a href="https://macaneseheritage.org/login/?lang=en">click here</a>.</p>
</body>
</html>

VBA UTILITIES

We record here VBA code to create lists of Given Names and of Nicknames. These were generated using ChatGPT.

GIVEN NAMES

Option Explicit

' ============================================================
' MODULE: GivenNamesCreate
' PURPOSE:
'   Build GivenNames.htm and separate GivenA.htm ... GivenZ.htm
'   from a source file containing exactly these columns:
'
'     A = ID
'     B = GivenName
'     C = Surname
'     D = Birthdate
'     E = Deathdate
'
' WHAT THIS MACRO DOES
'   1. Ask user to choose the source file
'      (focused on C:\UDF2\GivenNamesCreate)
'   2. Import the source into ImportedData
'   3. Copy valid rows into MergedData
'   4. Sort by given name, then surname
'   5. Remove duplicates using:
'        ID + GivenName + Surname + Birth + Death
'   6. Build HTML lines
'   7. Build full FinalHTML with:
'        - UTF-8
'        - newspaper layout
'        - scroll-to-top button
'   8. Export:
'        - GivenNames.htm
'        - GivenA.htm ... GivenZ.htm
'   9. Ask user for export folder
'      (focused on C:\UDF2\GivenFiles)
' ============================================================
 
Public Sub ProcessGivenNamesList()

Dim sourcePath As Variant
    Dim exportFolder As String
    Dim outputPath As String

Dim wsImport As Worksheet
    Dim wsMerged As Worksheet
    Dim wsFinal As Worksheet

Dim nextRow As Long
    Dim lastRow As Long
    Dim i As Long
    Dim outRow As Long

Dim personID As String
    Dim givenName As String
    Dim surname As String
    Dim birthDate As String
    Dim deathDate As String
    Dim htmlLine As String
    Dim displayText As String
    Dim firstLetter As String
    Dim currentLetter As String

Dim oldCalc As XlCalculation
    Dim oldStatusBar As Variant

On Error GoTo CleanFail

oldCalc = Application.Calculation
    oldStatusBar = Application.StatusBar

Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "Given names: starting..."

Set wsImport = EnsureSheet("ImportedData")
    Set wsMerged = EnsureSheet("MergedData")
    Set wsFinal = EnsureSheet("FinalHTML")

wsImport.Cells.Clear
    wsMerged.Cells.Clear
    wsFinal.Cells.Clear

' ------------------------------------------------------------
    ' STEP 1: Choose source file
    ' ------------------------------------------------------------
    ChDrive "C"
    ChDir "C:\UDF2\GivenNamesCreate"

sourcePath = Application.GetOpenFilename( _
        FileFilter:="Excel/CSV Files (*.xlsx;*.xlsm;*.xls;*.csv),*.xlsx;*.xlsm;*.xls;*.csv", _
        Title:="Select given names source file", _
        MultiSelect:=False)

If VarType(sourcePath) = vbBoolean Then
        If sourcePath = False Then GoTo CleanExit
    End If

' ------------------------------------------------------------
    ' STEP 2: Import source
    ' ------------------------------------------------------------
    Application.StatusBar = "Given names: importing source file..."
    ImportGivenSourceFile CStr(sourcePath), wsImport

' ------------------------------------------------------------
    ' STEP 3: Prepare merged sheet
    ' ------------------------------------------------------------
    Application.StatusBar = "Given names: preparing merged sheet..."
    PrepareMergedHeader wsMerged
    nextRow = 2

lastRow = LastUsedRow(wsImport, "A")

' ------------------------------------------------------------
    ' STEP 4: Copy valid rows
    ' ------------------------------------------------------------
    Application.StatusBar = "Given names: copying valid rows..."

For i = 2 To lastRow
        If i Mod 200 = 0 Or i = lastRow Then
            Application.StatusBar = "Given names: copying row " & i & " of " & lastRow
            DoEvents
        End If

personID = TrimSafe(wsImport.Cells(i, "A").Value)
        givenName = TrimSafe(wsImport.Cells(i, "B").Value)
        surname = TrimSafe(wsImport.Cells(i, "C").Value)
        birthDate = TrimSafe(wsImport.Cells(i, "D").Value)
        deathDate = TrimSafe(wsImport.Cells(i, "E").Value)

If Not IsBadGivenName(givenName, surname) Then
            wsMerged.Cells(nextRow, "A").Value = personID
            wsMerged.Cells(nextRow, "B").Value = givenName
            wsMerged.Cells(nextRow, "C").Value = surname
            wsMerged.Cells(nextRow, "D").Value = birthDate
            wsMerged.Cells(nextRow, "E").Value = deathDate
            nextRow = nextRow + 1
        End If
    Next i

lastRow = LastUsedRow(wsMerged, "B")

If lastRow < 2 Then
        MsgBox "No valid given-name rows were found.", vbExclamation
        GoTo CleanExit
    End If

' ------------------------------------------------------------
    ' STEP 5: Sort merged data
    ' ------------------------------------------------------------
    Application.StatusBar = "Given names: sorting merged data..."
    SortMergedData wsMerged, lastRow

' ------------------------------------------------------------
    ' STEP 6: Remove duplicates
    ' ------------------------------------------------------------
    Application.StatusBar = "Given names: removing duplicates..."
    RemoveMergedDuplicates wsMerged

lastRow = LastUsedRow(wsMerged, "B")

' ------------------------------------------------------------
    ' STEP 7: Build HTML lines
    ' ------------------------------------------------------------
    Application.StatusBar = "Given names: building HTML lines..."
    wsMerged.Range("I1").Value = "HTMLLine"

For i = 2 To lastRow
        If i Mod 200 = 0 Or i = lastRow Then
            Application.StatusBar = "Given names: building HTML row " & i & " of " & lastRow
            DoEvents
        End If

personID = TrimSafe(wsMerged.Cells(i, "A").Value)
        givenName = TrimSafe(wsMerged.Cells(i, "B").Value)
        surname = TrimSafe(wsMerged.Cells(i, "C").Value)
        birthDate = TrimSafe(wsMerged.Cells(i, "D").Value)
        deathDate = TrimSafe(wsMerged.Cells(i, "E").Value)

displayText = ExcelUpperText(TrimSafe(givenName & " " & surname))

htmlLine = "<div class=""name-entry""><a href=""[PERSON:H:" & personID & "]"">" & _
                   HtmlEncodeUtf8(displayText) & "</a> " & _
                   BuildDateBracket(birthDate, deathDate) & "</div>"

wsMerged.Cells(i, "I").Value = htmlLine
    Next i

' ------------------------------------------------------------
    ' STEP 8: Build final HTML sheet
    ' ------------------------------------------------------------
    Application.StatusBar = "Given names: building final HTML sheet..."
    outRow = 1
    WriteTopHtmlBlock wsFinal, outRow, "Given Names"

currentLetter = ""

For i = 2 To lastRow
        If i Mod 200 = 0 Or i = lastRow Then
            Application.StatusBar = "Given names: writing FinalHTML row " & i & " of " & lastRow
            DoEvents
        End If

givenName = TrimSafe(wsMerged.Cells(i, "B").Value)
        firstLetter = GroupLetterFromText(givenName)

If firstLetter <> currentLetter Then
            currentLetter = firstLetter

wsFinal.Cells(outRow, "A").Value = "<a id=""" & HtmlEncodeUtf8(currentLetter) & """></a>"
            outRow = outRow + 1

wsFinal.Cells(outRow, "A").Value = _
                "<div class=""letter-header"">" & HtmlEncodeUtf8(currentLetter) & "</div>"
            outRow = outRow + 1
        End If

wsFinal.Cells(outRow, "A").Value = wsMerged.Cells(i, "I").Value
        outRow = outRow + 1
    Next i

WriteBottomHtmlBlock wsFinal, outRow

' ------------------------------------------------------------
    ' STEP 9: Choose export folder
    ' ------------------------------------------------------------
    Application.StatusBar = "Given names: choose export folder..."
    exportFolder = GetFolderFromUser("Select the folder where GivenNames files will be exported")

If exportFolder = "" Then GoTo CleanExit

' ------------------------------------------------------------
    ' STEP 10: Export full file
    ' ------------------------------------------------------------
    Application.StatusBar = "Given names: exporting GivenNames.htm..."
    outputPath = exportFolder & "\GivenNames.htm"
    ExportSheetColumnAToUtf8Html wsFinal, outputPath

' ------------------------------------------------------------
    ' STEP 11: Export separate GivenA.htm ... GivenZ.htm
    ' ------------------------------------------------------------
    Application.StatusBar = "Given names: exporting separate letter files..."
    ExportSeparateGivenLetterFiles wsMerged, exportFolder

Application.StatusBar = False

MsgBox "Done." & vbCrLf & vbCrLf & _
           "Files exported to:" & vbCrLf & exportFolder, vbInformation

CleanExit:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = oldCalc
    Application.StatusBar = oldStatusBar
    Exit Sub

CleanFail:
    MsgBox "Error: " & Err.Description, vbCritical
    Resume CleanExit

End Sub

Private Sub ImportGivenSourceFile(ByVal sourcePath As String, ByVal wsTarget As Worksheet)

Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim lastRow As Long
    Dim ext As String

ext = LCase$(Mid$(sourcePath, InStrRev(sourcePath, ".") + 1))

If ext = "csv" Or ext = "txt" Then
        Set wbSrc = Workbooks.Open(Filename:=sourcePath, Local:=True)
    Else
        Set wbSrc = Workbooks.Open(Filename:=sourcePath, ReadOnly:=True)
    End If

Set wsSrc = wbSrc.Worksheets(1)
    lastRow = LastUsedRow(wsSrc, "A")

wsTarget.Cells.Clear

wsTarget.Range("A1").Value = "ID"
    wsTarget.Range("B1").Value = "GivenName"
    wsTarget.Range("C1").Value = "Surname"
    wsTarget.Range("D1").Value = "Birth"
    wsTarget.Range("E1").Value = "Death"

If lastRow >= 2 Then
        wsSrc.Range("A2:E" & lastRow).Copy Destination:=wsTarget.Range("A2")
    End If

wbSrc.Close SaveChanges:=False
End Sub

Private Sub PrepareMergedHeader(ByVal ws As Worksheet)

ws.Range("A1").Value = "ID"
    ws.Range("B1").Value = "GivenName"
    ws.Range("C1").Value = "Surname"
    ws.Range("D1").Value = "Birth"
    ws.Range("E1").Value = "Death"
    ws.Range("I1").Value = "HTMLLine"
End Sub

Private Sub SortMergedData(ByVal ws As Worksheet, ByVal lastRow As Long)

With ws.Sort
        .SortFields.Clear
        .SortFields.Add Key:=ws.Range("B2:B" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=ws.Range("C2:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange ws.Range("A1:I" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
End Sub

Private Sub RemoveMergedDuplicates(ByVal ws As Worksheet)

Dim lastRow As Long

lastRow = LastUsedRow(ws, "B")

With ws.Range("A1:I" & lastRow)
        .RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
    End With
End Sub

Private Sub ExportSeparateGivenLetterFiles(ByVal wsMerged As Worksheet, ByVal exportFolder As String)

Dim letterCode As Long
    Dim letterText As String
    Dim wsTemp As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim outRow As Long
    Dim givenName As String
    Dim firstLetter As String
    Dim filePath As String

Set wsTemp = EnsureSheet("TempLetterExport")
    wsTemp.Cells.Clear

lastRow = LastUsedRow(wsMerged, "B")

For letterCode = 65 To 90
        letterText = Chr$(letterCode)

Application.StatusBar = "Given names: exporting Given" & letterText & ".htm..."
        DoEvents

wsTemp.Cells.Clear
        outRow = 1

WriteTopHtmlBlock wsTemp, outRow, "Given Names - " & letterText

wsTemp.Cells(outRow, "A").Value = "<a id=""" & letterText & """></a>"
        outRow = outRow + 1

wsTemp.Cells(outRow, "A").Value = "<div class=""letter-header"">" & letterText & "</div>"
        outRow = outRow + 1

For i = 2 To lastRow
            If i Mod 300 = 0 Or i = lastRow Then
                Application.StatusBar = "Given names: Given" & letterText & ".htm row " & i & " of " & lastRow
                DoEvents
            End If

givenName = TrimSafe(wsMerged.Cells(i, "B").Value)
            firstLetter = GroupLetterFromText(givenName)

If firstLetter = letterText Then
                wsTemp.Cells(outRow, "A").Value = wsMerged.Cells(i, "I").Value
                outRow = outRow + 1
            End If
        Next i

WriteBottomHtmlBlock wsTemp, outRow

filePath = exportFolder & "\Given" & letterText & ".htm"
        ExportSheetColumnAToUtf8Html wsTemp, filePath
    Next letterCode
End Sub

Private Sub WriteTopHtmlBlock(ByVal ws As Worksheet, ByRef outRow As Long, ByVal pageTitle As String)

ws.Cells(outRow, "A").Value = "<!DOCTYPE html>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<html>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<head>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<meta charset=""utf-8"">"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<title>" & HtmlEncodeUtf8(pageTitle) & "</title>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<style>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "body { font-family: Arial, Helvetica, sans-serif; margin: 20px; }"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".newspaper { column-width: 250px; column-gap: 40px; column-rule: 1px solid silver; -webkit-column-width: 250px; -webkit-column-gap: 40px; -webkit-column-rule: 1px solid silver; -moz-column-width: 250px; -moz-column-gap: 40px; -moz-column-rule: 1px solid silver; }"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".letter-header { break-inside: avoid-column; -webkit-column-break-inside: avoid; page-break-inside: avoid; background-color:#FFF2CC; font-weight:bold; padding:6px 10px; margin-top:12px; margin-bottom:8px; }"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".name-entry { break-inside: avoid-column; -webkit-column-break-inside: avoid; page-break-inside: avoid; margin-bottom:6px; }"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "#scrollToTopButton { position:fixed; bottom:20px; right:20px; z-index:9999; display:none; border:1px solid #7FA9C9; background:#EAF3FB; color:#003A6B; padding:8px 12px; cursor:pointer; border-radius:6px; font-weight:bold; }"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "#scrollToTopButton:hover { background:#D7EAF8; }"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</style>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</head>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<body>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<a id=""TOP""></a>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<button id=""scrollToTopButton"" onclick=""window.scrollTo({top:0,behavior:'smooth'});"">Top</button>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<script>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "window.addEventListener('scroll', function() {"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  var btn = document.getElementById('scrollToTopButton');"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  if (window.pageYOffset > 200) {"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    btn.style.display = 'block';"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  } else {"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    btn.style.display = 'none';"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  }"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "});"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</script>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<div class=""container centre pad)%>"">"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<ul class=""centre"" style=""background-color: #B3D1F0; color:black; width:100%;font-size:1.5rem;"">"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<li style=""display:block;font-weight:bold;"">" & HtmlEncodeUtf8(pageTitle) & "</li>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</ul>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<div class=""newspaper"">"
    outRow = outRow + 1
End Sub

Private Sub WriteBottomHtmlBlock(ByVal ws As Worksheet, ByRef outRow As Long)

ws.Cells(outRow, "A").Value = "</div>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</body>"
    outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</html>"
    outRow = outRow + 1
End Sub

Private Sub ExportSheetColumnAToUtf8Html(ByVal ws As Worksheet, ByVal outputPath As String)

Dim lastRow As Long
    Dim i As Long
    Dim txt As String
    Dim stm As Object

lastRow = LastUsedRow(ws, "A")
    Set stm = CreateObject("ADODB.Stream")

With stm
        .Type = 2
        .Charset = "utf-8"
        .Open

For i = 1 To lastRow
            txt = CStr(ws.Cells(i, "A").Value)
            .WriteText txt & vbCrLf
        Next i

.SaveToFile outputPath, 2
        .Close
    End With

Set stm = Nothing
End Sub

Private Function GetFolderFromUser(ByVal dialogTitle As String) As String

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

With fd
        .Title = dialogTitle
        .AllowMultiSelect = False
        .InitialFileName = "C:\UDF2\GivenFiles\"

If .Show = -1 Then
            GetFolderFromUser = .SelectedItems(1)
        Else
            GetFolderFromUser = ""
        End If
    End With
End Function

Private Function EnsureSheet(ByVal sheetName As String) As Worksheet

On Error Resume Next
    Set EnsureSheet = ThisWorkbook.Worksheets(sheetName)
    On Error GoTo 0

If EnsureSheet Is Nothing Then
        Set EnsureSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        EnsureSheet.Name = sheetName
    End If
End Function

Private Function LastUsedRow(ByVal ws As Worksheet, ByVal colLetter As String) As Long

Dim n As Long

n = ws.Cells(ws.Rows.Count, colLetter).End(xlUp).Row
    If n < 1 Then n = 1
    LastUsedRow = n
End Function

Private Function TrimSafe(ByVal v As Variant) As String

If IsError(v) Then
        TrimSafe = ""
    ElseIf IsNull(v) Then
        TrimSafe = ""
    Else
        TrimSafe = Trim$(CStr(v))
    End If
End Function

Private Function IsBadGivenName(ByVal givenName As String, ByVal surname As String) As Boolean

givenName = TrimSafe(givenName)
    surname = TrimSafe(surname)

If givenName = "" Then
        IsBadGivenName = True
        Exit Function
    End If

If surname = "" Then
        IsBadGivenName = True
        Exit Function
    End If

If InStr(1, givenName, "?", vbTextCompare) > 0 Then
        IsBadGivenName = True
        Exit Function
    End If

If Left$(givenName, 2) = "--" Then
        IsBadGivenName = True
        Exit Function
    End If

If Left$(givenName, 1) = "-" Then
        IsBadGivenName = True
        Exit Function
    End If

IsBadGivenName = False
End Function

Private Function GroupLetterFromText(ByVal s As String) As String

Dim ch As String

s = TrimSafe(s)

If s = "" Then
        GroupLetterFromText = "#"
        Exit Function
    End If

ch = Left$(ExcelUpperText(s), 1)

Select Case ch
        Case "Á", "À", "Â", "Ã", "Ä", "Å"
            ch = "A"
        Case "É", "È", "Ê", "Ë"
            ch = "E"
        Case "Í", "Ì", "Î", "Ï"
            ch = "I"
        Case "Ó", "Ò", "Ô", "Õ", "Ö"
            ch = "O"
        Case "Ú", "Ù", "Û", "Ü"
            ch = "U"
        Case "Ç"
            ch = "C"
        Case "Ñ"
            ch = "N"
    End Select

If ch Like "[A-Z]" Then
        GroupLetterFromText = ch
    Else
        GroupLetterFromText = "#"
    End If
End Function

Private Function HtmlEncodeUtf8(ByVal s As String) As String

s = Replace(s, "&", "&")
    s = Replace(s, "<", "<")
    s = Replace(s, ">", ">")
    s = Replace(s, """", """)

HtmlEncodeUtf8 = s
End Function

Private Function BuildDateBracket(ByVal birthDate As String, ByVal deathDate As String) As String

birthDate = TrimSafe(birthDate)
    deathDate = TrimSafe(deathDate)

If birthDate = "" And deathDate = "" Then
        BuildDateBracket = ""
    Else
        BuildDateBracket = "(" & HtmlEncodeUtf8(birthDate) & "-" & HtmlEncodeUtf8(deathDate) & ")"
    End If
End Function

Private Function ExcelUpperText(ByVal s As String) As String

On Error Resume Next
    ExcelUpperText = Application.WorksheetFunction.Upper(s)

If Err.Number <> 0 Then
        Err.Clear
        ExcelUpperText = s
    End If

On Error GoTo 0
End Function

NICKNAMES

In the file NewNicknames.htm we described the steps in updating the Nicknames.htm file. Nothing else is needed but we record here the VBA code used to create the list of nicknames.

Option Explicit

' ============================================================
	' MODULE: NicknamesCreate
	' PURPOSE:
	'   Build Nicknames.htm by merging:
	'     1. main nickname file
	'     2. SpecialNicknames workbook
	'
	' MAIN FILE EXPECTED COLUMNS
	'   A = ID
	'   B = Nickname
	'   C = Surname
	'   D = Birthdate
	'   E = Deathdate
	'
	' SPECIAL FILE EXPECTED COLUMNS
	'   B = Nickname
	'   F = Final ready-made HTML
	'
	' OUTPUT FEATURES
	'   - UTF-8
	'   - A-Z jump links
	'   - newspaper layout
	'   - scroll-to-top button
	'   - letter headers
	'   - click tooltips for special nicknames
	' ============================================================

Public Sub ProcessNicknamesList()

Dim mainPath As Variant
		Dim specialPath As Variant
		Dim exportFolder As String
		Dim outputPath As String

Dim wsImport As Worksheet
		Dim wsMerged As Worksheet
		Dim wsFinal As Worksheet

Dim nextRow As Long
		Dim lastRow As Long
		Dim i As Long
		Dim outRow As Long

Dim personID As String
		Dim nickname As String
		Dim surname As String
		Dim birthDate As String
		Dim deathDate As String
		Dim htmlLine As String
		Dim displayText As String
		Dim firstLetter As String
		Dim currentLetter As String

Dim oldCalc As XlCalculation
		Dim oldStatusBar As Variant

On Error GoTo CleanFail

oldCalc = Application.Calculation
		oldStatusBar = Application.StatusBar

Application.ScreenUpdating = False
		Application.EnableEvents = False
		Application.DisplayAlerts = False
		Application.Calculation = xlCalculationManual
		Application.StatusBar = "Nicknames list: starting..."

Set wsImport = EnsureSheet("ImportedData")
		Set wsMerged = EnsureSheet("MergedData")
		Set wsFinal = EnsureSheet("FinalHTML")

wsImport.Cells.Clear
		wsMerged.Cells.Clear
		wsFinal.Cells.Clear

' ------------------------------------------------------------
		' STEP 1: Choose main nickname source file
		' ------------------------------------------------------------
		ChDrive "C"
		ChDir "C:\UDF2\NicknamesCreate"

mainPath = Application.GetOpenFilename( _
			FileFilter:="Excel/CSV Files (*.xlsx;*.xlsm;*.xls;*.csv),*.xlsx;*.xlsm;*.xls;*.csv", _
			Title:="Select main nickname source file", _
			MultiSelect:=False)

If VarType(mainPath) = vbBoolean Then
			If mainPath = False Then GoTo CleanExit
		End If

Application.StatusBar = "Nicknames list: importing main source..."
		ImportMainSourceFile CStr(mainPath), wsImport

' ------------------------------------------------------------
		' STEP 2: Prepare merged sheet
		' ------------------------------------------------------------
		PrepareMergedHeader wsMerged
		nextRow = 2

Application.StatusBar = "Nicknames list: copying main nickname rows..."
		nextRow = CopyValidRowsFromMainSheet(wsImport, wsMerged, nextRow)

' ------------------------------------------------------------
		' STEP 3: Choose SpecialNicknames workbook
		' ------------------------------------------------------------
		Application.StatusBar = "Nicknames list: choose SpecialNicknames workbook..."

ChDrive "C"
		ChDir "C:\UDF2\NicknamesCreate"

specialPath = Application.GetOpenFilename( _
			FileFilter:="Excel Files (*.xlsx;*.xlsm;*.xls),*.xlsx;*.xlsm;*.xls", _
			Title:="Select SpecialNicknames workbook", _
			MultiSelect:=False)

If Not (VarType(specialPath) = vbBoolean And specialPath = False) Then
			Application.StatusBar = "Nicknames list: merging SpecialNicknames..."
			nextRow = CopyRowsFromSpecialWorkbook(CStr(specialPath), wsMerged, nextRow)
		End If

lastRow = LastUsedRow(wsMerged, "B")

If lastRow < 2 Then
			MsgBox "No valid nickname rows were found.", vbExclamation
			GoTo CleanExit
		End If

' ------------------------------------------------------------
		' STEP 4: Sort merged data
		' ------------------------------------------------------------
		Application.StatusBar = "Nicknames list: sorting merged data..."
		SortMergedData wsMerged, lastRow

' ------------------------------------------------------------
		' STEP 5: Build normal HTML lines where needed
		' ------------------------------------------------------------
		Application.StatusBar = "Nicknames list: building HTML lines..."
		wsMerged.Range("I1").Value = "HTMLLine"

For i = 2 To lastRow
			If i Mod 200 = 0 Or i = lastRow Then
				Application.StatusBar = "Nicknames list: building HTML lines... row " & i & " of " & lastRow
				DoEvents
			End If

personID = TrimSafe(wsMerged.Cells(i, "A").Value)
			nickname = TrimSafe(wsMerged.Cells(i, "B").Value)
			surname = TrimSafe(wsMerged.Cells(i, "C").Value)
			birthDate = TrimSafe(wsMerged.Cells(i, "D").Value)
			deathDate = TrimSafe(wsMerged.Cells(i, "E").Value)
			htmlLine = TrimSafe(wsMerged.Cells(i, "I").Value)

If htmlLine = "" Then
				displayText = ExcelUpperText(TrimSafe(nickname & " " & surname))

htmlLine = "<div class=""nick-entry""><a href=""[PERSON:H:" & personID & "]"">" & _
						   HtmlEncodeUtf8(displayText) & "</a> " & _
						   BuildDateBracket(birthDate, deathDate) & "</div>"

wsMerged.Cells(i, "I").Value = htmlLine
			End If
		Next i

' ------------------------------------------------------------
		' STEP 6: Build final HTML sheet
		' ------------------------------------------------------------
		Application.StatusBar = "Nicknames list: building final HTML sheet..."

outRow = 1
		WriteTopHtmlBlock wsFinal, outRow

currentLetter = ""

For i = 2 To lastRow
			nickname = TrimSafe(wsMerged.Cells(i, "B").Value)
			firstLetter = GroupLetterFromText(nickname)

If firstLetter <> currentLetter Then
				currentLetter = firstLetter

wsFinal.Cells(outRow, "A").Value = "<a id=""" & HtmlEncodeUtf8(currentLetter) & """></a>"
				outRow = outRow + 1

wsFinal.Cells(outRow, "A").Value = _
					"<div class=""letter-header"">" & HtmlEncodeUtf8(currentLetter) & "</div>"
				outRow = outRow + 1
			End If

wsFinal.Cells(outRow, "A").Value = wsMerged.Cells(i, "I").Value
			outRow = outRow + 1

If i Mod 200 = 0 Or i = lastRow Then
				Application.StatusBar = "Nicknames list: writing FinalHTML... row " & i & " of " & lastRow
				DoEvents
			End If
		Next i

WriteBottomHtmlBlock wsFinal, outRow

' ------------------------------------------------------------
		' STEP 7: Choose export folder
		' ------------------------------------------------------------
		Application.StatusBar = "Nicknames list: choose export folder..."
		exportFolder = GetFolderFromUser("Select the folder where Nicknames.htm will be exported")

If exportFolder = "" Then GoTo CleanExit

outputPath = exportFolder & "\Nicknames.htm"

' ------------------------------------------------------------
		' STEP 8: Export
		' ------------------------------------------------------------
		Application.StatusBar = "Nicknames list: exporting UTF-8 HTML..."
		ExportSheetColumnAToUtf8Html wsFinal, outputPath

Application.StatusBar = False

MsgBox "Done." & vbCrLf & vbCrLf & _
			   "Output file:" & vbCrLf & outputPath, vbInformation

CleanExit:
		Application.ScreenUpdating = True
		Application.EnableEvents = True
		Application.DisplayAlerts = True
		Application.Calculation = oldCalc
		Application.StatusBar = oldStatusBar
		Exit Sub

CleanFail:
		MsgBox "Error: " & Err.Description, vbCritical
		Resume CleanExit

End Sub

Private Sub ImportMainSourceFile(ByVal sourcePath As String, ByVal wsTarget As Worksheet)

Dim wbSrc As Workbook
		Dim wsSrc As Worksheet
		Dim lastRow As Long
		Dim ext As String

ext = LCase$(Mid$(sourcePath, InStrRev(sourcePath, ".") + 1))

If ext = "csv" Or ext = "txt" Then
			Set wbSrc = Workbooks.Open(Filename:=sourcePath, Local:=True)
		Else
			Set wbSrc = Workbooks.Open(Filename:=sourcePath, ReadOnly:=True)
		End If

Set wsSrc = wbSrc.Worksheets(1)
		lastRow = LastUsedRow(wsSrc, "A")

wsTarget.Cells.Clear
		wsTarget.Range("A1").Value = "ID"
		wsTarget.Range("B1").Value = "Nickname"
		wsTarget.Range("C1").Value = "Surname"
		wsTarget.Range("D1").Value = "Birthdate"
		wsTarget.Range("E1").Value = "Deathdate"

If lastRow >= 2 Then
			wsSrc.Range("A2:E" & lastRow).Copy Destination:=wsTarget.Range("A2")
		End If

wbSrc.Close SaveChanges:=False
	End Sub

Private Function CopyValidRowsFromMainSheet(ByVal wsSource As Worksheet, ByVal wsTarget As Worksheet, ByVal nextRow As Long) As Long

Dim lastRow As Long
		Dim i As Long

Dim personID As String
		Dim nickname As String
		Dim surname As String
		Dim birthDate As String
		Dim deathDate As String

lastRow = LastUsedRow(wsSource, "A")

For i = 2 To lastRow
			personID = TrimSafe(wsSource.Cells(i, "A").Value)
			nickname = TrimSafe(wsSource.Cells(i, "B").Value)
			surname = TrimSafe(wsSource.Cells(i, "C").Value)
			birthDate = TrimSafe(wsSource.Cells(i, "D").Value)
			deathDate = TrimSafe(wsSource.Cells(i, "E").Value)

If Not IsBadNickname(nickname, surname) Then
				wsTarget.Cells(nextRow, "A").Value = personID
				wsTarget.Cells(nextRow, "B").Value = nickname
				wsTarget.Cells(nextRow, "C").Value = surname
				wsTarget.Cells(nextRow, "D").Value = birthDate
				wsTarget.Cells(nextRow, "E").Value = deathDate
				wsTarget.Cells(nextRow, "I").Value = ""
				nextRow = nextRow + 1
			End If
		Next i

CopyValidRowsFromMainSheet = nextRow
	End Function

Private Function CopyRowsFromSpecialWorkbook(ByVal filePath As String, ByVal wsTarget As Worksheet, ByVal nextRow As Long) As Long

Dim wbSrc As Workbook
		Dim wsSrc As Worksheet
		Dim lastRow As Long
		Dim i As Long

Dim nickname As String
		Dim htmlLine As String

On Error GoTo CleanFail

Set wbSrc = Workbooks.Open(Filename:=filePath, ReadOnly:=True)
		Set wsSrc = FindSpecialSheet(wbSrc)

lastRow = LastUsedRow(wsSrc, "B")

For i = 2 To lastRow
			nickname = TrimSafe(wsSrc.Cells(i, "B").Value)
			htmlLine = TrimSafe(wsSrc.Cells(i, "F").Value)

If nickname <> "" And htmlLine <> "" Then
				wsTarget.Cells(nextRow, "A").Value = ""
				wsTarget.Cells(nextRow, "B").Value = nickname
				wsTarget.Cells(nextRow, "C").Value = ""
				wsTarget.Cells(nextRow, "D").Value = ""
				wsTarget.Cells(nextRow, "E").Value = ""
				wsTarget.Cells(nextRow, "I").Value = htmlLine
				nextRow = nextRow + 1
			End If
		Next i

wbSrc.Close SaveChanges:=False
		CopyRowsFromSpecialWorkbook = nextRow
		Exit Function

CleanFail:
		On Error Resume Next
		If Not wbSrc Is Nothing Then wbSrc.Close SaveChanges:=False
		CopyRowsFromSpecialWorkbook = nextRow
	End Function

Private Function FindSpecialSheet(ByVal wb As Workbook) As Worksheet

Dim ws As Worksheet

For Each ws In wb.Worksheets
			If LCase$(TrimSafe(ws.Range("B1").Value)) = "nickname" Then
				Set FindSpecialSheet = ws
				Exit Function
			End If
		Next ws

Set FindSpecialSheet = wb.Worksheets(1)
	End Function

Private Sub PrepareMergedHeader(ByVal ws As Worksheet)

ws.Range("A1").Value = "ID"
		ws.Range("B1").Value = "Nickname"
		ws.Range("C1").Value = "Surname"
		ws.Range("D1").Value = "Birthdate"
		ws.Range("E1").Value = "Deathdate"
		ws.Range("I1").Value = "HTMLLine"
	End Sub

Private Sub SortMergedData(ByVal ws As Worksheet, ByVal lastRow As Long)

With ws.Sort
			.SortFields.Clear
			.SortFields.Add Key:=ws.Range("B2:B" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
			.SortFields.Add Key:=ws.Range("C2:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
			.SetRange ws.Range("A1:I" & lastRow)
			.Header = xlYes
			.MatchCase = False
			.Orientation = xlTopToBottom
			.Apply
		End With
	End Sub

Private Sub WriteTopHtmlBlock(ByVal ws As Worksheet, ByRef outRow As Long)

ws.Cells(outRow, "A").Value = "<!DOCTYPE html>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<html>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<head>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<meta charset=""utf-8"">"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<title>Nicknames</title>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<style>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "body { font-family: Arial, Helvetica, sans-serif; margin: 20px; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".az-links { margin: 12px 0 16px 0; padding: 8px 10px; background-color: #EAF3FB; border: 1px solid #B3D1F0; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".az-links a { font-weight: bold; text-decoration: none; margin-right: 6px; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".nick-entry { break-inside: avoid-column; -webkit-column-break-inside: avoid; page-break-inside: avoid; margin-bottom:6px; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "#scrollToTopButton:hover { background:#D7EAF8; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".tooltip { position: relative; cursor: pointer; display: inline-block; color: #005A9C; text-decoration: underline; text-decoration-style: dotted; text-underline-offset: 0.15em; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".tooltiptext { display: none; position: absolute; top: 100%; left: 0; background-color: #005A9C; color: white; padding: 0.75em 2em 0.75em 0.75em; border-radius: 5px; z-index: 1000; max-width: 400px; min-width: 200px; box-shadow: 0 2px 6px rgba(0, 0, 0, 0.3); white-space: normal; margin-top: 6px; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".tooltip.active .tooltiptext { display: block; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".close-tooltip { position: absolute; top: 5px; right: 8px; background: transparent; border: none; color: #fff; font-size: 16px; font-weight: bold; cursor: pointer; line-height: 1; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".tooltiptext a { color: #ffffff; text-decoration: underline; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".tooltiptext div { margin-bottom: 0.35em; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = ".tooltiptext div:last-child { margin-bottom: 0; }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</style>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</head>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<body>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<a id=""TOP""></a>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<button id=""scrollToTopButton"" onclick=""window.scrollTo({top:0,behavior:'smooth'});"">Top</button>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<script>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "window.addEventListener('scroll', function() {"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  var btn = document.getElementById('scrollToTopButton');"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  if (window.pageYOffset > 200) {"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    btn.style.display = 'block';"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  } else {"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    btn.style.display = 'none';"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "});"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "document.addEventListener('click', function(e) {"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  var clickedTooltip = e.target.closest('.tooltip');"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  var closeBtn = e.target.closest('.close-tooltip');"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  var tooltipLink = e.target.closest('.tooltiptext a');"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  if (tooltipLink) {"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    return;"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  document.querySelectorAll('.tooltip.active').forEach(function(t) {"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    if (t !== clickedTooltip) {"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "      t.classList.remove('active');"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  });"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  if (closeBtn) {"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    e.preventDefault();"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    e.stopPropagation();"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    var parentTooltip = closeBtn.closest('.tooltip');"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    if (parentTooltip) parentTooltip.classList.remove('active');"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    return;"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  if (clickedTooltip) {"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    e.preventDefault();"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    e.stopPropagation();"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "    clickedTooltip.classList.toggle('active');"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "  }"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "});"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</script>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<div class=""container centre pad)%>"">"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<ul class=""centre"" style=""background-color: #B3D1F0; color:black; width:100%;font-size:1.5rem;"">"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<li style=""display:block;font-weight:bold;"">Nicknames</li>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</ul>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = BuildAlphabetLinksHtml()
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "<div class=""newspaper"">"
		outRow = outRow + 1
	End Sub

Private Function BuildAlphabetLinksHtml() As String

Dim s As String
		Dim i As Long
		Dim letterText As String

s = "<div class=""az-links"">"

For i = 65 To 90
			letterText = Chr$(i)
			If i > 65 Then s = s & " "
			s = s & "<a href=""#" & letterText & """>" & letterText & "</a>"
		Next i

s = s & "</div>"
		BuildAlphabetLinksHtml = s
	End Function

Private Sub WriteBottomHtmlBlock(ByVal ws As Worksheet, ByRef outRow As Long)

ws.Cells(outRow, "A").Value = "</div>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</body>"
		outRow = outRow + 1

ws.Cells(outRow, "A").Value = "</html>"
		outRow = outRow + 1
	End Sub

Private Sub ExportSheetColumnAToUtf8Html(ByVal ws As Worksheet, ByVal outputPath As String)

Dim lastRow As Long
		Dim i As Long
		Dim txt As String
		Dim stm As Object

lastRow = LastUsedRow(ws, "A")
		Set stm = CreateObject("ADODB.Stream")

With stm
			.Type = 2
			.Charset = "utf-8"
			.Open

For i = 1 To lastRow
				txt = CStr(ws.Cells(i, "A").Value)
				.WriteText txt & vbCrLf
			Next i

.SaveToFile outputPath, 2
			.Close
		End With

Set stm = Nothing
	End Sub

Private Function GetFolderFromUser(ByVal dialogTitle As String) As String

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

With fd
			.Title = dialogTitle
			.AllowMultiSelect = False
			.InitialFileName = "C:\UDF2\uiFiles\UserItems\"

If .Show = -1 Then
				GetFolderFromUser = .SelectedItems(1)
			Else
				GetFolderFromUser = ""
			End If
		End With
	End Function

Private Function EnsureSheet(ByVal sheetName As String) As Worksheet

On Error Resume Next
		Set EnsureSheet = ThisWorkbook.Worksheets(sheetName)
		On Error GoTo 0

If EnsureSheet Is Nothing Then
			Set EnsureSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
			EnsureSheet.Name = sheetName
		End If
	End Function

Private Function LastUsedRow(ByVal ws As Worksheet, ByVal colLetter As String) As Long

Dim n As Long

n = ws.Cells(ws.Rows.Count, colLetter).End(xlUp).Row
		If n < 1 Then n = 1
		LastUsedRow = n
	End Function

Private Function TrimSafe(ByVal v As Variant) As String

If IsError(v) Then
			TrimSafe = ""
		ElseIf IsNull(v) Then
			TrimSafe = ""
		Else
			TrimSafe = Trim$(CStr(v))
		End If
	End Function

Private Function IsBadNickname(ByVal nickname As String, ByVal surname As String) As Boolean

nickname = TrimSafe(nickname)
		surname = TrimSafe(surname)

If nickname = "" Then
			IsBadNickname = True
			Exit Function
		End If

If surname = "" Then
			IsBadNickname = True
			Exit Function
		End If

If InStr(1, nickname, "?", vbTextCompare) > 0 Then
			IsBadNickname = True
			Exit Function
		End If

If Left$(nickname, 2) = "--" Then
			IsBadNickname = True
			Exit Function
		End If

If Left$(nickname, 1) = "-" Then
			IsBadNickname = True
			Exit Function
		End If

IsBadNickname = False
	End Function

Private Function GroupLetterFromText(ByVal s As String) As String

Dim ch As String

s = TrimSafe(s)

If s = "" Then
			GroupLetterFromText = "#"
			Exit Function
		End If

ch = Left$(ExcelUpperText(s), 1)

Select Case ch
			Case "Á", "À", "Â", "Ã", "Ä", "Å"
				ch = "A"
			Case "É", "È", "Ê", "Ë"
				ch = "E"
			Case "Í", "Ì", "Î", "Ï"
				ch = "I"
			Case "Ó", "Ò", "Ô", "Õ", "Ö"
				ch = "O"
			Case "Ú", "Ù", "Û", "Ü"
				ch = "U"
			Case "Ç"
				ch = "C"
			Case "Ñ"
				ch = "N"
		End Select

If ch Like "[A-Z]" Then
			GroupLetterFromText = ch
		Else
			GroupLetterFromText = "#"
		End If
	End Function

Private Function HtmlEncodeUtf8(ByVal s As String) As String

s = Replace(s, "&", "&")
		s = Replace(s, "<", "<")
		s = Replace(s, ">", ">")
		s = Replace(s, """", """)

HtmlEncodeUtf8 = s
	End Function

Private Function BuildDateBracket(ByVal birthDate As String, ByVal deathDate As String) As String

birthDate = TrimSafe(birthDate)
		deathDate = TrimSafe(deathDate)

If birthDate = "" And deathDate = "" Then
			BuildDateBracket = ""
		Else
			BuildDateBracket = "(" & HtmlEncodeUtf8(birthDate) & "-" & HtmlEncodeUtf8(deathDate) & ")"
		End If
	End Function

Private Function ExcelUpperText(ByVal s As String) As String

On Error Resume Next
		ExcelUpperText = Application.WorksheetFunction.Upper(s)

If Err.Number <> 0 Then
			Err.Clear
			ExcelUpperText = s
		End If

On Error GoTo 0
	End Function

DISPLAY

SCROLL TO TOP

Coding for a scroll-to-top button that is used on these training pages

<!-- ===========================================
  SCROLL TO TOP — Self-contained (HTML Text) — v4 (White Border)
  WHAT THIS DOES:
  - Single button + full CSS/JS here.
  - Background: #005A9C
  - Text: #fedb7f
  - White border for contrast over footer.
  - Vertical ellipse (less tall).
  - No browser focus halo.
  
  This is entered into the Extra Content field of all pages of Page Sets 
  =========================================== -->

<style>
  #scrollToTopButton{
    position:fixed;
    right:20px;
    bottom:20px;
    z-index:99999;

    /* Shape */
    width:44px;
    height:54px;
    border-radius:999px;

    display:grid;
    place-items:center;

    background-color:#005A9C;
    color:#fedb7f;

    /* NEW: white border for visibility over footer */
    border:2px solid #ffffff;

    outline:none !important;

    font-size:26px;
    line-height:1;
    cursor:pointer;

    box-shadow:0 6px 18px rgba(0,0,0,.18);

    opacity:0;
    visibility:hidden;
    transform:translateY(10px);
    transition:opacity .25s, transform .25s, visibility .25s;

    -webkit-tap-highlight-color: transparent;
    user-select:none;
    -webkit-user-select:none;
  }

  #scrollToTopButton.visible{
    opacity:1;
    visibility:visible;
    transform:translateY(0);
  }

  #scrollToTopButton:hover{
    box-shadow:0 8px 22px rgba(0,0,0,.24);
  }

  #scrollToTopButton:focus,
  #scrollToTopButton:focus-visible,
  #scrollToTopButton:active{
    outline:none !important;
    box-shadow:0 6px 18px rgba(0,0,0,.18) !important;
  }

  @media (max-width:480px){
    #scrollToTopButton{
      right:14px;
      bottom:14px;
      width:40px;
      height:50px;
      font-size:24px;
    }
  }

  @media (prefers-reduced-motion: reduce){
    html:focus-within{ scroll-behavior:auto; }
    #scrollToTopButton{ transition:none; }
  }
</style>

<script>
(function () {
  var id = 'scrollToTopButton';
  var threshold = 300;

  var btn = document.getElementById(id);
  if (!btn) return;

  btn.addEventListener('click', function () {
    try { window.scrollTo({ top: 0, behavior: 'smooth' }); }
    catch (e) { window.scrollTo(0, 0); }
    try { btn.blur(); } catch(e) {}
  });

  function update() {
    var y = window.pageYOffset || document.documentElement.scrollTop || 0;
    if (y > threshold) btn.classList.add('visible');
    else btn.classList.remove('visible');
  }

  window.addEventListener('scroll', function () {
    window.requestAnimationFrame(update);
  }, { passive: true });

  update();
})();
</script>

RESPONSIVE

Purpose: This code is entered in PageSets → Main Page → Extra Head. It performs two functions:

On screens wider than 900 pixels, it forces containers using the .equal-cols class to display all columns at equal widths.
It loads the Lora Google font so that it is available throughout the site.

DEVELOPER CODE

LOGIN AND REGISTRATION CODES

REGISTRATION.PHP

REGISTO.PHP

VALIDATION.PHP

REDIRECT TO REGISTRATION/LOGIN FORM

VBA UTILITIES

GIVEN NAMES

NICKNAMES

DISPLAY

SCROLL TO TOP

READ MORE

RESPONSIVE