sopa de letras en excel

Un lector me comenta que pudo visualizar varias sopas de letras en YouTube, realizadas con Excel. Inmediatamente me dirigí a dicho sitio y busqué información al respecto. Los ejemplos son buenos y si, efectivamente, podemos armar una muy buena "sopa de letras", salvo que (digamos) es un trabajo bastante manual, cosa que intento evitar a toda costa en mis proyectos. Obviamente que la tarea de automatización incluye Macros, lo cual me insume tiempo, pero queda mucho mejor. Vamos primero a explicar muy brevemente la forma de realizar esta juego "a la clásica", para luego pasar a un desarrollo mucho mas complejo, pero también automatizado y realista.

la clásica grilla de una sopa de letras

[+/-] Ver el resto / Ocultar

Bien, analicemos un poco la imagen superior: 1) es una grilla de 20 filas x 20 columnas, aunque bien podríamos hacerla del tamaño que quisiéramos. 2) Cada celda tiene una letra, que fue generada  mediante la anidación de dos funciones. 3) Vean ahora la barra de fórmulas: =CAR(ALEATORIO.ENTRE(65;90)), mismas funciones que menciono en el punto anterior.

Todos sabemos que un ordenador se maneja con números. Y las letras no son la excepción. Para nuestra PC la A ("a" mayúscula) es el número 65, la B el 66 y así respectivamente, hasta llegar a la Z, cuyo correspondiente número es el 90.

En la función "interna" de la anidación, le solicito a Excel que genere un número aleatorio entre 65 y 90, para así abarcar todo el espectro de las letras mayúsculas de nuestro abecedario. Esto es =ALEATORIO.ENTRE(65;90), lo cual me deja la tabla así:

vean la barra de fórmulas y así analizarán los nros obtenidos.

Luego es sencillo: coloco a ALEATORIO.ENTRE() dentro de la función =CAR(número), que se encarga de convertir el argumento (siempre numérico) en una letra o caracter. Es el equivalente a la función de VBA Char(), que en versiones mas "viejitas" de Excel se llamaba de una forma mas intuitiva: =CARACTER().

Como agregado, les muestro la forma de averiguar el número de cada letra o caracter, con la función inversa a CAR(): =CODIGO(letra):

con =CODIGO(letra) tomo un caracter y averiguo su número Ascii

Hasta acá todo claro, ya sabemos como está formada la grilla mostrada al principio. Generamos números aleatorios entre 65 y 90 y luego le anidamos CAR(), para determinar que letra es ese número. Así nos aseguramos, en forma rápida y sencilla, de crear 400 letras al azar.

Pero todos sabemos que una sopa de letras debe contener, entre tanta mezcolanza, palabras del "mundo real", para que nuestros jugadores tengan el desafío de encontrarlas. Estimo como tremendamente imposible que, de esta forma, aparezcan muchas palabras (con sus letras contiguas) que tengan un significado lógico, como: casa, ferrocarril, escuela, computadora, etc, etc, etc. Así que, y muy a nuestro pesar, deberemos incorporar esas palabras "a mano", intentando mezclarlas lo mejor posible.

Pero ojo.... antes de tocar esa grilla, recordemos que está de por medio la función ALEATORIO(), y que esta  cambia de valor cada vez que registre alguna alteración en la hoja de cálculos. Es decir: si modificamos una celda..... cambiarán las letras de toda la grilla. Un desastre, ya que así nunca llegaremos a armar una sola palabra coherente. Entonces: primero copiamos la grilla, luego hacemos "pegado especial / valores", para que Excel quite las funciones y solo deje las letras:

observen la  barra de fórmulas: luego de "pegado especial / valores" vemos una "A" y no la función.

Recién ahora podemos agregar manualmente algunas palabras, las cuales resaltaré en rojo para que entiendan sin problemas el ejemplo:

luego de unos minutos de trabajo, paciencia y (mucho) cuidado de no equivocarme, armé las palabras que mis jugadores deberán encontrar.

Listo, ya está el juego. Digamos que, para fines caseros, el ejemplo es bueno.... aunque si (como en mi caso) tenés 4 hijos y debes armarle algo así cada vez que quieran jugar, les terminás comprando una revista de sopa de letras y a otra cosa, por que es bastante pesada la labor. Y resta una cuestión ¿quién corrige esta sopa de letras, para saber si nuestros usuarios seleccionaron bien todas las palabras ocultas? Ahora vamos a la automatización.

======================================================================

Segunda parte del post:

Con macros vamos a llenar esa grilla, de la siguiente forma:

1) "Alt + F11" para ingresar a VBA

2) Insertamos un módulo

3) Generamos este código:

Sub CrearGrilla()

Dim Filas, Columnas As Byte
Dim F, C As Integer
'previamente seleccioné la grilla y le dí un nombre bien
'descriptivo y poco original: "grilla"
'limpio el rango:
Range("grilla").ClearContents
'averiguo cuantas filas y columnas posee la grilla:
Filas = Range("grilla").Rows.Count
Columnas = Range("grilla").Columns.Count
'genero la semilla aleatoria con Randomize
Randomize
'con un blucle recorro la grilla:
For C = 1 To Columnas
    For F = 1 To Filas
        'aqui genero un aleatorio.entre con:
        'Int(90 - 65 + 1) * Rnd + 65), anidándolo
        'dentro de Chr(), que me devolverá la letra
        'correspondiente a ese número:
        Cells(F, C).Value = Chr(Int(90 - 65 + 1) * Rnd + 65)
    Next F
Next C
End Sub

Bien, ese breve código rellena nuestra grilla de letras, creadas al azar. Y es realmente breve, ya que podrán observar que gran parte de lo escrito es código comentado, para una mejor interpretación.

Mas adelante invertiremos el orden en el que voy haciendo las cosas, por ahora muestro "de a partes", para luego armar "el todo".
Lo visto no es complicado, ahora comienza la etapa en la cual hay que razonar.
Como primer medida, deberé tener una hoja auxiliar en donde cargar las palabras que utilizaré. Esto me permitirá contar con una muy buena base de datos, a la cual podré ir agregándole registros y así ampliando las posibilidades y dificultad del juego. Esta hoja se llamará "diccionario", y utilizaremos la columna A para ir agregando las palabras que insertaremos en la grilla. Seleccionamos dicha columna y le aplicamos un nombre, por ejemplo: tabla:

listo.

Ahora ¿que cantidad de palabras y como las seleccionaremos para incluirlas en la grilla de juego?
Primer respuesta: podemos agregar una celda que indique el nivel de dificultad. Mientras mas difícil, mas palabras colocamos en la grilla de juego.
Segunda respuesta: generamos un número aleatorio y lo usamos como Fila del rango "tabla", colocando esa palabra en la grilla.

Así brindaremos al usuario que nivel de juego desea encarar:

con la "validación de datos" solo permito que en esa celda (a la cual llamé "nivel" desde el cuadro de nombres) solo existan tres posibilidades: facil, dificil y muy difícil. Luego, internamente y desde nuestra macro, decidiremos cuantas palabras incorporar de acuerdo al nivel seleccionado.

Ya tenemos nuestro "diccionario" de palabras y que nivel se utilizará. Pero quedan varias cosas por resolver aún:
¿En que celda comienzo a colocar una palabra?
Una vez que tengo esa celda (la cual también puedo elegir de forma aleatoria: ¿como hago para que la palabra seleccionada no exceda los límites de la tabla? Ejemplo: tengo "ferrocarril", que posee once letras. ¿Como evito lo que podría suceder en la siguiente imagen?:

si no prevengo este error... los resultados serán realmente malos.

Antes de colocar la palabra, entonces, tengo que "medir" su longitud y hacia que lado (arriba, abajo, derecha o izquierda) debo empezar a colocarla, para evitar que se salga de los límites físicos de la grilla. Ahhhh, e ir analizando que tampoco suceda esto:

¿Que sucedió en la imagen de arriba? Sencillo: primero coloqué la palabra "azúcar" y luego, al colocar "perro", pisé la palabra existente, generando un grave error, reemplazando la C por la E de perro.
Irán entendiendo por qué todas estas sopas de letras se hacen de la forma "fácil". No será del todo sencillo evitar esto errores y, menos para mí, explicarlos de una forma "entendible". Espero lograrlo.
Pero, pero, pero: estamos generando una aplicación totalmente automatizada, lo que nos permitirá:
1) Hacernos los cancheros por crearla, ya que no todos realizan esto. =)
2) Venderla
3) Quedar bien en la escuela de los chicos, dándole este archivo a la maestra
4) Si dicen que realizar este tipo de juegos agiliza  la mente, podemos jactarnos de que la agilizamos x 5, ya que al margen de resolverlo... lo diseñamos.

Los puntos 2 y 3 son ciertos, los otros para joder un rato.

Es hora de ir acomodando todo este lío planteado y armar una secuencia de pasos lógicos a seguir:

Primer boceto:
1) Determinar la cantidad de palabras a incorporar, de acuerdo al nivel elegido.
2) Seleccionar esas palabras del diccionario
3) Colocar palabra x palabra en la grilla, cuidando de no "pisar" ninguna que ya esté allí escrita y que (a la vez) su longitud no exceda los límites físicos de la misma.

Segundo boceto:
1) Nivel facil: 4 palabras - Dificil: 6 palabras - Muy dificil: 10 palabras
2) Generar un número aleatorio entre 1 y la cantidad de filas ocupadas en el rango "tabla". Con dicho número obtenemos una fila: copiamos la palabra que esté en esa celda a otra hoja, evitando cualquier alteración en la base de datos original.
3) Generamos dos números aleatorios, para determinar en que fila y columna colocaremos la palabra. Antes debemos corroborar: que la celda elegida al azar no contenga ningún dato, calcular el largo de la palabra y evitar que exceda el tamaño de la grilla y que en su camino no se interponga otra palabra.

Generemos en una hoja aparte (temp) las palabras que utilizaremos:

Sub SeleccionarPalabras()
Dim aleaF, X, UltimaFila, FilaBuscar, J As Integer
Dim Palabras As Byte
Dim Palabra As String
'limpio cualquier dato existente
Sheets("temp").Range("dic_temp").ClearContents
'veo hasta que fila se cargaron palabras en la
'hoja diccionario:
UltimaFila = Sheets("diccionario").Cells(65536, 1).End(xlUp).Row

'en base al nivel de juego determino la cantidad
'de palabras a colocar en la grilla:
Select Case Sheets("grilla").Range("nivel").Value
        Case Is = "facil"
            Palabras = 4
        Case Is = "dificil"
            Palabras = 6
        Case Is = "muy dificil"
            Palabras = 10
End Select
'y con un bucle continúo:
Randomize
For X = 1 To Palabras
de_nuevo:
    'creo un nro aleatorio, entre 1 y la cantidad de palabras
    'que hay en la hoja "diccionario"
    aleaF = Int((UltimaFila * Rnd) + 1)
    'con la fila aleatoria creada, tomo una palabra:
    Palabra = UCase(Sheets("diccionario").Cells(aleaF, 1).Value)
    'antes de llevarme esa palabra a la hoja temporal, debo veri
    'ficar que la misma no haya sido seleccionada previamente:
    On Error Resume Next
    FilaBuscar = Sheets("temp").Range("dic_temp").Find(Palabra).Row
    'si se produce un error, la palabra no está:
    If Err.Number <> 0 Then
        'sumo uno a J para usarlo como fila en la hoja temp
        J = J + 1
        'y coloco la palabra
        Sheets("temp").Cells(J, 1).Value = Palabra
    Else
    'si no hubo error en la busqueda es por que esa palabra ya existe
    'en la hoja temp, así que vuelvo a intentarlo:
        GoTo de_nuevo
    End If
Next X
End Sub

Y tal como se lo ordenamos, aquí está el resultado en la hoja "temp"

previamente seleccioné "muy difícil" en el nivel, y la macro copió 10 palabras (sin repetir) desde la hoja "diccionario" a la hoja "temp", de forma totalmente automática  y aleatoria.

Bueno gente, ya tenemos las palabras a utilizar. Seguimos con el código para colocarlas en la grilla de juego, y atención acá: por que definiremos aleatoriamente su ubicación, pero también es requisito indispensable controlar que no exceda los límites de la grilla y que no "pise" a una palabra ya colocada.

Crearemos un Sub llamado Inicio, el cual contendrá tres pasos, muy sencillos de identificar:

Sub Inicio()
If Range("nivel").Value = "" Then
    MsgBox "seleccione un nivel", vbExclamation, "faltan datos"
    Exit Sub
End If

SeleccionarPalabras
ColocarPalabrasEnLaGrilla
RellenarGrilla
End Sub

Con el código que diseñé hasta el momento, obtenemos lo siguiente:

nuestra macro colocó las palabras (sin irse de los límites ni "tapar" a otra) y las detalló a la derecha, para que el jugador sepa que buscar.

En otra imagen vemos el efecto del Sub RellenarCeldas, que se encargará de colocar letras aleatorias en todas las celdas vacías:

ahora si es bastante complicado encontrar nuestras palabras

El código para lograrlo es el que describo a continuación. Aunque está bastante comentado, puede causar confusión, dado que es un poco extenso en comparación a pequeñas macros. Les recomiendo bajar el archivo, ir a VBA y colocar algunos puntos de interrupción, para luego hacer el "paso a paso" con F8. Eso les permitirá ir viendo como las variables van cambiando de valor y otros detalles que hacen al desarrollo en general:

estos puntos de interrupción nos permitirán ir viendo como avanza el programa, en "cámara lenta"

Aquí las líneas prometidas:

Sub Inicio()
If Range("nivel").Value = "" Then
    MsgBox "seleccione un nivel", vbExclamation, "faltan datos"
    Exit Sub
End If

SeleccionarPalabras
ColocarPalabrasEnLaGrilla
RellenarGrilla
End Sub

Sub SeleccionarPalabras()
Dim aleaF, X, UltimaFila, FilaBuscar, J As Integer
Dim Palabras As Byte
Dim Palabra As String
'limpio cualquier dato existente
Sheets("temp").Range("dic_temp").ClearContents
'veo hasta que fila se cargaron palabras en la
'hoja diccionario:
UltimaFila = Sheets("diccionario").Cells(65536, 1).End(xlUp).Row

'en base al nivel de juego determino la cantidad
'de palabras a colocar en la grilla:
Select Case Sheets("grilla").Range("nivel").Value
        Case Is = "facil"
            Palabras = 6
        Case Is = "dificil"
            Palabras = 10
        Case Is = "muy dificil"
            Palabras = 15
End Select
'y con un bucle continúo:
Randomize
For X = 1 To Palabras
de_nuevo:
    'creo un nro aleatorio, entre 1 y la cantidad de palabras
    'que hay en la hoja "diccionario"
    aleaF = Int((UltimaFila * Rnd) + 1)
    'con la fila aleatoria creada, tomo una palabra:
    Palabra = UCase(Sheets("diccionario").Cells(aleaF, 1).Value)
    'antes de llevarme esa palabra a la hoja temporal, debo veri
    'ficar que la misma no haya sido seleccionada previamente:
    On Error Resume Next
    FilaBuscar = Sheets("temp").Range("dic_temp").Find(Palabra).Row
    'si se produce un error, la palabra no está:
    If Err.Number <> 0 Then
        'sumo uno a J para usarlo como fila en la hoja temp
        J = J + 1
        'y coloco la palabra
        Sheets("temp").Cells(J, 1).Value = Palabra
    Else
    'si no hubo error en la busqueda es por que esa palabra ya existe
    'en la hoja temp, así que vuelvo a intentarlo:
        GoTo de_nuevo
    End If
Next X
End Sub
Sub ColocarPalabrasEnLaGrilla()
Dim Uf, X, J, aleaF, aleaC As Integer
Dim Palabra, Letra As String
Dim Resultado, Posi As Byte
'veo hasta donde se colocaron palabras en la hoja temp
Uf = Sheets("temp").Cells(65536, 1).End(xlUp).Row
Range("grilla").ClearContents
Columns("AA").ClearContents
'y con un bucle voy recorriendo ese rango, tomando
'palabra x palabra:
For X = 1 To Uf
    Palabra = UCase(Sheets("temp").Cells(X, 1).Value)
    'genero una fila y una columna aleatorias, para
    'colocar allí la palabra. Uso la cantidad de filas y columnas
    'presenten en la grilla para generar el maximo valor aleatorio
    'posible
otra_vez:
    Posi = 0
    aleaF = Int((Sheets("grilla").Range("grilla").Rows.Count * Rnd) + 1)
    aleaC = Int((Sheets("grilla").Range("grilla").Columns.Count * Rnd) + 1)
   
    'si esa celda está desocupada, prosigo:
    If Sheets("grilla").Cells(aleaF, aleaC).Value = "" Then
        'llamo a la función creada, la cual puede devolverme 5 valores:
        '1=arriba, 2=abajo, 3=izquierda, 4=derecha, 0=sin camino.
        'en base a esos valores, sabré hacia donde colocar la palabra:
        Resultado = AnalizarCamino(aleaF, aleaC, Palabra)
        Select Case Resultado
            Case 1 'puedo colocar la palabra hacia arriba
                For J = aleaF To (aleaF - Len(Palabra) + 1) Step -1
                    Posi = Posi + 1
                    Cells(J, aleaC).Value = Mid(Palabra, Posi, 1)
                Next J
            Case 2 'puedo colocar la palabra hacia abajo
                For J = aleaF To (aleaF + (Len(Palabra) - 1))
                    Posi = Posi + 1
                    Cells(J, aleaC).Value = Mid(Palabra, Posi, 1)
                Next J
            Case 3 'puedo colocar la palabra hacia la izquierda
                For J = aleaC To (aleaC - Len(Palabra) + 1) Step -1
                    Posi = Posi + 1
                    Cells(aleaF, J).Value = Mid(Palabra, Posi, 1)
                Next J
            Case 4 'puedo colocar la palabra hacia la derecha
                For J = aleaC To (aleaC + (Len(Palabra) - 1))
                    Posi = Posi + 1
                    Cells(aleaF, J).Value = Mid(Palabra, Posi, 1)
                Next J
            Case 0 'si la función no encontró un camino
                'genero otra posición aleatoria
                GoTo otra_vez
        End Select
    Else 'si la celda está ocupada, repito la ubicacion:
        GoTo otra_vez
    End If
    'coloco la palabra al costado de la grilla, para que el
    'jugador sepa cuales debe encontrar:
    ttt = ttt + 1
    Range("aa" & ttt).Value = Palabra
Next X
End Sub

Sub RellenarGrilla()
Dim Filas, Columnas, Letra As Byte
Dim F, C As Integer
'previamente seleccioné la grilla y le dí un nombre bien
'descriptivo y poco original: "grilla"

'averiguo cuantas filas y columnas posee la grilla:
Filas = Range("grilla").Rows.Count
Columnas = Range("grilla").Columns.Count
'le doy un valor a Letra y genero la semilla aleatoria
'con Randomize
Letra = 65
Randomize
'con un blucle recorro la grilla:
For C = 1 To Columnas
    For F = 1 To Filas
        'aqui genero un aleatorio.entre con:
        'Int(90 - 65 + 1) * Rnd + 65), anidándolo
        'dentro de Chr(), que me devolverá la letra
        'correspondiente a ese número:
        If Cells(F, C).Value = "" Then
            Cells(F, C).Value = Chr(Int((90 - 65 + 1) * Rnd + 65))
        End If
    Next F
Next C
End Sub

Function AnalizarCamino(fila, columna, p) As Byte
Dim Largo, X As Byte
Dim Rng As Range
'mido la longitud de la palabra:
Largo = Len(p)
'ahora tengo cuatro alternativas para ir colocando
'letra x letra en la grilla: arriba, abajo, izquierda
'o derecha. voy a "ver" en cada dirección, cuidando
'de no irme fuera de la grilla o pisar otra palabra.
'al detectar una via libre, le doy un valor a la función
'y salgo, retornando al sub llamador
'==========================================================================
'pongo la funcion en 0
AnalizarCamino = 0
'controlo contra el límite superior (arriba). ej: si estoy en la fila
'7 y la palabra tiene un largo de 6 letras, puedo colocarla. pero si
'tiene un largo de 10 letras, no, entonces este bloque If.. queda
'descartado, y continúo con el siguiente.
'si el largo de la palabra es menor o igual a la fila en donde estoy
'posicionado, puedo ir "hacia arriba"
If Largo <= fila Then
    'armo el rango que ocupará la palabra
    Set Rng = Range(Cells(fila, columna), Cells((fila - Largo) + 1, columna))
    'ahora uso a CONTARA(), mediante la worksheetfunction respectiva, para
    'saber si hay alguna letra (de otra palabra) que se interponga en el
    'camino. si esta funcion me retorna 0, entonces la vía está libre:
    If Application.WorksheetFunction.CountA(Rng) = 0 Then
        AnalizarCamino = 1
        GoTo salida
    End If
End If
'analicemos hacia abajo, usando la misma lógica anterior:
'si el largo de la palabra es menor o igual al total de filas:
If (fila + Largo - 1) <= Range("grilla").Rows.Count Then
    Set Rng = Range(Cells(fila, columna), Cells((fila + Largo) - 1, columna))
    If Application.WorksheetFunction.CountA(Rng) = 0 Then
        AnalizarCamino = 2
        GoTo salida
    End If
End If
'ahora hacia la izquierda:
If Largo <= columna Then
    Set Rng = Range(Cells(fila, columna), Cells(fila, (columna - Largo) + 1))
    If Application.WorksheetFunction.CountA(Rng) = 0 Then
        AnalizarCamino = 3
        GoTo salida
    End If
End If
'revisamos hacia la derecha:
If (columna + Largo - 1) <= Range("grilla").Columns.Count Then
    Set Rng = Range(Cells(fila, columna), Cells(fila, (columna + Largo) - 1))
    If Application.WorksheetFunction.CountA(Rng) = 0 Then
        AnalizarCamino = 4
        GoTo salida
    End If
End If

salida:
Set Rng = Nothing
End Function

Al juego se le pueden hacer innumerables mejoras, muchas de las cuales las dejo a su imaginación y criterio. Una herramienta infaltable: permitir que el usuario seleccione un rango de la grilla y decirle si el mismo se encuentra o no dentro de las palabras que debe encontrar. A esto lo haremos posible insertando código en el evento Worksheet_SelectionChange de la hoja "grilla"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim EstaPalabra, EstaPalabraInversa, Rango As String
Dim Efila, Errores As Integer
Dim Celda As Range

'una forma sencilla de evitar que se ejecute el código
'si la selección está fuera de la grilla:
If Target.Row > Range("grilla").Rows.Count Then
    Exit Sub
ElseIf Target.Column > Range("grilla").Columns.Count Then
    Exit Sub
End If

Errores = 0
'si el usuario selecciona mas de dos rangos:
'(presionando ctrol)
If Target.Areas.Count > 1 Then

    Exit Sub
'aqui solo permito que el rango seleccionado tenga una sola
'columna o una sola fila:
ElseIf Target.Rows.Count > 1 And Target.Columns.Count > 1 Then

    Exit Sub
Else
    'almaceno la direccion del rango
    Rango = Target.Address
    'ahora que tengo la seleccion correcta, armo la palabra,
    'recorriendo ese rango, uniendo letra por letra en la
    'variable EstaPalabra
    For Each Celda In Selection.Cells
        EstaPalabra = Trim(EstaPalabra) & Trim(Celda.Value)
    Next Celda
    'busco esa palabra en el listado de la derecha:
buscar_de_nuevo:
    On Error Resume Next
    Columns("AA:AA").Select
    Efila = Selection.Find(What:=EstaPalabra, after:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row
    'si hay error, la palabra NO está
    If Err.Number <> 0 Then
        'sumo el contador:
        Errores = Errores + 1
        If Errores = 2 Then
            MsgBox "La palabra seleccionada no existe en la lista", vbCritical, "Error"
            Range("v7").Select
            Exit Sub
        End If
        'y por que necesito de dos errores. sencillo, por que la palabra puede
        'estar escrita tanto a la derecha como al revés:
        'bien puede ser "casa" o "asac". entonces, vamos a dar vuelta la palabra
        For X = Len(EstaPalabra) To 1 Step -1
            EstaPalabraInversa = EstaPalabraInversa & Mid(EstaPalabra, X, 1)
        Next X
        EstaPalabra = EstaPalabraInversa
        GoTo buscar_de_nuevo
    Else
        MsgBox "La palabra " & EstaPalabra & " está correctamente seleccionada", vbInformation
        'coloreo las letras:
        Range(Rango).Font.Color = vbRed
        Range("v7").Select
    End If
End If
End Sub

Luego de elegir un rango, el código de arriba busca esa palabra en la lista y, si está, colorea en la grilla dicha palabra en rojo:

listo.

Quedan muchas cosas por mejorar, pero "la base está" y les permitirá comenzar a jugar. No olviden agregar este código:
range("grilla").font.color = xlAutomatic
al momento de generar la nueva grilla, así eliminamos las letras en rojo del juego anterior.

Podríamos crear diccionarios por categoría, para llenar la tabla sólo con nombres de países, marcas de autos, bebidas, etc, etc, y hasta llevar un registro por jugador, para conocer en cuanto tiempo finalizó la tarea. Pero vayan imanginandose que tal tarea demanda bastante código extra, motivo por el cual no lo incluyo en esta entrada. Lo elemental ya lo tienen, será cuestión de ir ampliando de acuerdo a las necesidades o gustos de cada uno. Si necesitan ayuda en algo, solo tienen que avisar.
Aqui les dejo el link al archivo.