Fill MT cells in a range

B

Biff

Hello Folks!

My VBA knowledge is slim to none so I need a little help
with a macro.

I would like a macro that fills MT cells in a range with
random uppercase letters A-Z. The cells will not always be
contiguous. I'm playing around with a word search puzzle
and looking for a quick way to fill the MT cells.

Thanks for your help
Biff
 
K

keepITcool

Biff,

I dont know what you mean with MT cells,
but does this work for you?

If fills the selected cells..


Sub FillPuzzle()
Dim c As Range
Randomize
For Each c In Selection.Cells
c = Chr$(64 + Int(26 * Rnd + 1))
Next
End Sub



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
B

Biff

Thanks keepITcool !

Yes, that works. I think I can figure out just enough to
tweak it a little. Well, maybe not.....but I'll try it.

At what line of that macro would I add code to make the
selection of the MT(empty) cells automatic?

Thanks
Biff
 
B

Biff

Ok! Figured it out! Woo!

Sub FillPuzzle()
Dim c As Range
Range("A1:D7").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Randomize
For Each c In Selection.Cells
c = Chr$(64 + Int(26 * Rnd + 1))
Next
Range("A1").Select
End Sub

Biff
 
D

Dave Peterson

MT = empty


Biff,

I dont know what you mean with MT cells,
but does this work for you?

If fills the selected cells..

Sub FillPuzzle()
Dim c As Range
Randomize
For Each c In Selection.Cells
c = Chr$(64 + Int(26 * Rnd + 1))
Next
End Sub

keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
Click to expand...
 
D

Dave Peterson

And using KeepItCool's code:

Option Explicit
Sub FillPuzzle2()

Dim c As Range
Dim myRng As Range

Set myRng = Nothing
On Error Resume Next
Set myRng = Intersect(Selection, _
Selection.Cells.SpecialCells(xlCellTypeBlanks))
On Error GoTo 0

if myrng is nothing then
msgbox "No empty cells in selection"
exit sub
end if

Randomize
For Each c In myRng.Cells
c = Chr$(64 + Int(26 * Rnd + 1))
Next c
End Sub

Select your range and run the code.
 
B

Biff

Thanks to both Dave and keepITcool!

Here's what I ended up with:

Sub FillPuzzle()
Dim c As Range
Application.ScreenUpdating = False
Range("Puzzle").Select
Selection.SpecialCells(xlCellTypeBlanks).Select

Randomize
For Each c In Selection.Cells
c = Chr$(64 + Int(26 * Rnd + 1))
Next
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Works just fine. Now, if I could only figure a way to
automatically place the words in the puzzle !!! That one
might cause some brain damage though!

Biff
 
Top