Biblical verses with each letter of your name

[officeinstructor]

This is a church project
I have 26 alphabetic tables each containing a different number of records but all of the 26 alphabetic tables consist of the same columns: Column 1 the alphabet letter of that table (A, B, ......Z), Column 2 a verse from the Bible starting with that letter, column 3 the chapter & verse number of the mentioned verse. In other words: Table A contains tens of Biblical verses all starting with letter A, Table B contains tens of Biblical verses all starting with letter B, and so on...
What I want is to be able To input a Full name (whatever name: First middle and Last names) in a cell as an input, and when I press enter (or even press a button that activates a macro) I get report with Biblical verses from the 26 tables ONE verse for each letter of the Full Name: example : For the name is Marc William Peterson (this is the input) I want excel to search randomly in each relevant table and retreive 19 verses one for each letter of the mentioned name : a verse starting with M, then another starting with A, then a third starting with R and so on. There should be no duplication of verses for the same name.So if a certain name contains 2 A or 2 E like the example, the retreived verses must be different. Of course we should take in consideration to trim extra spaces during the input of names.

 

[al_b_cnu]

Hi, Welcome to the board!

Assuming the following:
1) A sheet named 'Table' has, starting in row 2, the table identifier index letter in column A, and the verse text required in column B
2) You require to enter text in cell A1 of your input sheet
3) the output texts are to appear below, in cells A2 onwards

Try this sheet change event:

Option Explicit
'-- Name of sheet containing tables                              --
'-- it is assumed that the data is contiguous, starting in row 2 --
Const msTableSheet As String = "Table"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iPtr As Integer, iIndexPtr As Integer, iRandomPtr As Integer, iTableEntriesCount As Integer
Dim iLoopPtr As Integer
Dim lOutputPtr As Long
Dim sInputText As String, sCurChar As String, sRandomText As String
Dim vaTables() As Variant

'-- Exit if cell A1 not changed --
If Target.Address <> "$A$1" Then Exit Sub

'-- Get input text string --
sInputText = Trim$(CStr(Target.Value))

'-- Process if not blank --
If sInputText <> "" Then

    '-- Empty output column from A2 onwards --
    Intersect(Range("A2:A" & Rows.Count), Columns("A")).ClearContents
    
    AssembleLookupTable vaTables
    
    Randomize
    
    lOutputPtr = 1
    For iPtr = 1 To Len(sInputText)
        sCurChar = UCase$(Mid$(sInputText, iPtr, 1))
        iIndexPtr = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", sCurChar)
        
        '-- Process if current character is alphabetic --
        If iIndexPtr <> 0 Then
            iTableEntriesCount = Val(vaTables(iIndexPtr, 1))
            If iTableEntriesCount > 0 Then
                iRandomPtr = Int((iTableEntriesCount * Rnd) + 1)
                sRandomText = vaTables(iIndexPtr, iRandomPtr + 1)
                vaTables(iIndexPtr, iRandomPtr + 1) = ""
                If sRandomText = "" Then
                    iLoopPtr = iRandomPtr + 1
                    If iLoopPtr > iTableEntriesCount Then iLoopPtr = 1
                    Do While iLoopPtr <> iRandomPtr
                        sRandomText = vaTables(iIndexPtr, iLoopPtr + 1)
                        If sRandomText <> "" Then
                            vaTables(iIndexPtr, iLoopPtr + 1) = ""
                            Exit Do
                        End If
                        iLoopPtr = iLoopPtr + 1
                        If iLoopPtr > iTableEntriesCount Then iLoopPtr = 1
                    Loop
                End If
                
                If sRandomText <> "" Then
                    '-- Output text to cell A2 onwards --
                    lOutputPtr = lOutputPtr + 1
                    Application.EnableEvents = False
                    On Error Resume Next
                    Cells(lOutputPtr, 1).Value = sRandomText
                    On Error GoTo 0
                    Application.EnableEvents = True
                End If
            End If
        End If
    Next iPtr
End If
End Sub

Private Sub AssembleLookupTable(ByRef Table() As Variant)
Dim iTablePtr As Integer, iCurCount As Integer, iCurPtr As Integer
Dim lRowEnd As Long, lRow As Long
Dim sCurIndex As String
Dim vaInput As Variant
Dim wsTable As Worksheet

Set wsTable = Sheets(msTableSheet)
lRowEnd = wsTable.Cells(Rows.Count, "A").End(xlUp).Row

'-- Read data into arrray --
vaInput = wsTable.Range("A1:C" & lRowEnd).Value

'-- Initialise lookup table --
ReDim Table(1 To 26, 1 To 1)

For lRow = 2 To UBound(vaInput, 1)
    
    '-- Get next Letter index & convert to a pointer between 1 & 26 --
    sCurIndex = UCase$(Left$(CStr(vaInput(lRow, 1)) & " ", 1))
    iTablePtr = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", sCurIndex)
    If iTablePtr <> 0 Then
        '-- Populate table array with element 1 = count of entries, elements 2 onwards = verses --
        iCurCount = Val(Table(iTablePtr, 1)) + 1
        iCurPtr = iCurCount + 1
        If iCurPtr > UBound(Table, 2) Then ReDim Preserve Table(1 To 26, 1 To iCurPtr)
        Table(iTablePtr, 1) = iCurCount
        Table(iTablePtr, iCurPtr) = CStr(vaInput(lRow, 2))
    End If
Next lRow

End Sub