Biblical verses with each letter of your name

officeinstructor

New Member
Joined
Apr 16, 2010
Messages
1
:confused: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.
 

Some videos you may like

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

al_b_cnu

Well-known Member
Joined
Jul 18, 2003
Messages
4,494
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:
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,630
Messages
5,597,277
Members
414,133
Latest member
lucid33

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top