Dim bd(3, 4)
Dim cons, vowels, usedC(20), usedV(6), usedInWord(3, 4), wordList
Dim noWds4, wordCt, solCt, theWord, continue

Private Sub Command1_Click()
 continue = 1
End Sub

Private Sub Form_Load()
  Me.Visible = True
  wordList = ""
  cons = "bcdfghjklmnpqrstvwxz": vowels = "aeiouy"
  Print Len(cons) + Len(vowels)
  Open "\words\words4.txt" For Binary As #1
  noWds4 = LOF(1) / 4
  place 1, 1
  Print "done"
End Sub
Function isWord(w)
 wd$ = String$(4, " ")
 low = 1: high = noWds4
 Do
  m = Int((low + high) / 2)
  Get #1, (m - 1) * 4 + 1, wd$
  If w = wd$ Then Exit Do
  If wd$ < w Then low = m + 1 Else high = m - 1
 Loop Until low > high
 If w = wd$ Then isWord = True: theWord = w Else isWord = False
End Function
Sub place(row, col)
 DoEvents
 If row = 1 Then
  bgn = 1
  If col = 1 Or col = 3 Then fin = Len(cons) Else fin = Len(vowels)
 Else
  Select Case col
   Case 1, 3
    bgn = InStr(cons, bd(row - 1, col)) + 1
    fin = Len(cons)
   Case Else
    bgn = InStr(vowels, bd(row - 1, col)) + 1
    fin = Len(vowels)
  End Select
 End If
 For i = bgn To fin
  good = 1
  If fin = Len(vowels) Then
    If usedV(i) = 0 Then ltr = Mid(vowels, i, 1): usedV(i) = -1 Else good = 0
  Else
    If usedC(i) = 0 Then ltr = Mid(cons, i, 1): usedC(i) = -1 Else good = 0
  End If
  If good Then
   bd(row, col) = ltr
   wSave = wordList
  
   wordAdd = 0
   If row = 1 Then
    If col = 4 Then
     If isWord(bd(1, 1) + bd(1, 2) + bd(1, 3) + bd(1, 4)) Then wordAdd = 1
    End If
   Else
    Select Case col
     Case 1: b1 = row: e1 = row: b2 = 1: e2 = row - 1: b3 = 1: e3 = row - 1: b4 = 1: e4 = row - 1
     Case 2: b1 = 1: e1 = row: b2 = row: e2 = row: b3 = 1: e3 = row - 1: b4 = 1: e4 = row - 1
     Case 3: b1 = 1: e1 = row: b2 = 1: e2 = row: b3 = row: e3 = row: b4 = 1: e4 = row - 1
     Case 4: b1 = 1: e1 = row: b2 = 1: e2 = row: b3 = 1: e3 = row: b4 = row: e4 = row
    End Select
    For i1 = b1 To e1
     For i2 = b2 To e2
      For i3 = b3 To e3
       For i4 = b4 To e4
        If isWord(bd(i1, 1) + bd(i2, 2) + bd(i3, 3) + bd(i4, 4)) Then
          wordAdd = wordAdd + 1
          usedInWord(i1, 1) = usedInWord(i1, 1) + 1
          usedInWord(i2, 2) = usedInWord(i2, 2) + 1
          usedInWord(i3, 3) = usedInWord(i3, 3) + 1
          usedInWord(i4, 4) = usedInWord(i4, 4) + 1
          wordList = wordList + bd(i1, 1) + bd(i2, 2) + bd(i3, 3) + bd(i4, 4) + Chr(13) + Chr(10)
        End If
       Next
      Next
     Next
    Next
   End If  ' row 1 vs not 1
   wordCt = wordCt + wordAdd
  
   If wordCt <= 3 * row Then
     c = col + 1: r = row
     If c > 4 Then c = 1: r = r + 1
     If r > 3 Then
      If wordCt < 9 Then
       CurrentX = 1: CurrentY = 1
       Text1.Text = ""
       For r = 1 To 3
        For c = 1 To 4
         If usedInWord(r, c) = 0 Then good = 0: Exit For
        Next
        If good = 0 Then Exit For
       Next
       If good Then
            solCt = solCt + 1
            For r = 1 To 3
             For c = 1 To 4
              Print bd(r, c);
              Text1.Text = Text1.Text + bd(r, c)
             Next: Print "    ": Text1.Text = Text1.Text + Chr(13) + Chr(10)
            Next: Print solCt; "   "
            Text1.Text = Text1.Text + Chr(13) + Chr(10) + wordList + Chr(13) + Chr(10) + Str(wordCt)
            Print theWord; "      "
            continue = 0
            Do
             DoEvents
            Loop Until continue = 1
       End If
      End If
      DoEvents
     Else
      place r, c
     End If
   End If
  
    For i1 = b1 To e1
     For i2 = b2 To e2
      For i3 = b3 To e3
       For i4 = b4 To e4
        If isWord(bd(i1, 1) + bd(i2, 2) + bd(i3, 3) + bd(i4, 4)) Then
          usedInWord(i1, 1) = usedInWord(i1, 1) - 1
          usedInWord(i2, 2) = usedInWord(i2, 2) - 1
          usedInWord(i3, 3) = usedInWord(i3, 3) - 1
          usedInWord(i4, 4) = usedInWord(i4, 4) - 1
        End If
       Next
      Next
     Next
    Next
   
   wordList = wSave
   wordCt = wordCt - wordAdd
   If fin = Len(vowels) Then
    usedV(i) = 0
   Else
    usedC(i) = 0
   End If
  End If
 Next
End Sub

shows as the 35th potential solution (I've discarded results relying on obscure words):

bace
fogi
hupy

face
foci
fuci
huge
hope
bogy
fogy

 7

It shows 7 formable words, but fuci is obscure, and it's not needed for any of the letters placed in the mauve area, bringing the word count down to 6. In fact we can remove fogy as being obscure bringing the total down to 5, but then we make problematic why we leave bogy, needed for the b.