SOLVED

# ....

Occasional Contributor

27 Replies

# Re: How to Fill Series With Letters

You cannot do that with Fill Series as far as I know.

Enter the following formula in O1:

=RIGHT("000000"&BASE(ROW()-1,13),6)

Fill down as far as you want.

..........

# Re: How to Fill Series With Letters

Change the number 13 in the formula. It is 10+the number of letters that you want.

So for example, if you want ABCDEF, change 13 to 16, and if you want ABCD, change it to 14.

..........

# Re: How to Fill Series With Letters

A worksheet in an Excel workbook (*.xlsx, *.xlsb or *.xlsm) has 1048576 rows.

The number of worksheets in a workbook is limited by the available memory. In a recent dicussion someone managed to create more than 65000 sheets in a workbook.

The formula in my previous reply could have been simpler:

=BASE(ROW()-1,13,6)

If you fill the first 1000000 rows on the first sheet, you could continue on the second sheet with

=BASE(ROW()-1+1000000,13,6)

and on the third sheet with

=BASE(ROW()-1+2000000,13,6)

etc.

..........

# Re: How to Fill Series With Letters

Run the following macro. I'd test it with a small number of sheets and rows first.

``````Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
For i = 1 To NumSheets
With Wsh.Range("A1:A" & NumRows)
.Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
End With
DoEvents
Next i
Wbk.Worksheets(1).Delete
Application.ScreenUpdating = True
End Sub``````

..........

..........

..........

# Re: How to Fill Series With Letters

This version will ask you which column you want to use.

``````Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Col As String
Dim Rng As Range
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Col = InputBox(Prompt:="In which column do you want the entries (A, B, ...)?")
On Error Resume Next
Set Rng = Range(Col & 1)
If Err Then
Beep
Exit Sub
End If
On Error GoTo 0
Application.ScreenUpdating = False
For i = 1 To NumSheets
With Wsh.Cells(1, Col).Resize(NumRows)
.Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
End With
DoEvents
Next i
Wbk.Worksheets(1).Delete
Application.ScreenUpdating = True
End Sub``````

# Re: How to Fill Series With Letters

I'm not sure I understand what you want, but here is a version that will fill multiple columns:

``````Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
For i = 1 To NumSheets
Wsh.Range("A1").Resize(NumRows).Value = "This"
Wsh.Range("B1").Resize(NumRows).Value = "That"
Wsh.Range("C1").Resize(NumRows).Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
Wsh.Range("D1").Resize(NumRows).Value = "Other"
Wsh.Range("E1").Resize(NumRows).Value = "Something"
DoEvents
Next i
Wbk.Worksheets(1).Delete
Application.ScreenUpdating = True
End Sub``````

# Re: How to Fill Series With Letters

..........

best response confirmed by AlremeithiMohamed (Occasional Contributor)
Solution

# Re: How to Fill Series With Letters

This version will create a text file; it will prompt you for the folder and filename.

It'll be slow, though.

``````Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
Dim Filename As Variant
Dim f As Integer
Dim r As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
For i = 1 To NumSheets
Wsh.Range("A1").Resize(NumRows).Value = "This"
Wsh.Range("B1").Resize(NumRows).Value = "That"
Wsh.Range("C1").Resize(NumRows).Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
Wsh.Range("D1").Resize(NumRows).Value = "Other"
Wsh.Range("E1").Resize(NumRows).Value = "Something"
DoEvents
Next i
Wbk.Worksheets(1).Delete
Application.ScreenUpdating = True
Filename = Application.GetSaveAsFilename(FileFilter:="Text File (*.txt),*.txt", Title:="Save to Text File")
If Filename = False Then
Exit Sub
End If
f = FreeFile
Open Filename For Output As #f
For i = 1 To NumSheets
For r = 1 To NumRows
Print #f, Worksheets(i).Range("C" & r).Text
Next r
Next i
Close #f
End Sub``````

..........

..........

# Re: How to Fill Series With Letters

Does this do what you want?

``````Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
Dim Filename As Variant
Dim f As Integer
Dim r As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
For i = 1 To NumSheets
Wsh.Range("A2").Resize(NumRows).Value = "This"
Wsh.Range("B2").Resize(NumRows).Value = "That"
Wsh.Range("C2").Resize(NumRows).Formula = "=BASE(ROW()-2+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
Wsh.Range("D2").Resize(NumRows).Value = "Other"
Wsh.Range("E2").Resize(NumRows).Value = "Something"
Wsh.Range("A" & NumRows + 2 & ":E" & NumRows + 2).Value = Array("Footer 1", "Footer 2", "Footer 3", "Footer 4", "Footer 5")
DoEvents
Next i
Wbk.Worksheets(1).Delete
Application.ScreenUpdating = True
Filename = Application.GetSaveAsFilename(FileFilter:="Text File (*.txt),*.txt", Title:="Save to Text File")
If Filename = False Then
Exit Sub
End If
f = FreeFile
Open Filename For Output As #f
For i = 1 To NumSheets
For r = 1 To NumRows + 2
Print #f, Worksheets(i).Range("C" & r).Text
Next r
Next i
Close #f
End Sub``````

..........

# Re: How to Fill Series With Letters

Here it is split into two separate macros:

``````Sub GenerateSheets()
Dim NumLetters As Long
Dim NumSheets As Long
Dim NumRows As Long
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim i As Long
NumLetters = Application.InputBox(Prompt:="How many letters do you want to use (max 26)?", Type:=1)
If NumLetters < 1 Or NumLetters > 26 Then
Beep
Exit Sub
End If
NumSheets = Application.InputBox(Prompt:="How many sheets do you want to create?", Type:=1)
If NumSheets < 1 Then
Beep
Exit Sub
End If
If NumSheets > 4000 Then
If MsgBox(Prompt:="Warning! This could take a long time! Do you want to continue?", _
Buttons:=vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
NumRows = Application.InputBox(Prompt:="How many rows per sheet do you want to fill?", Type:=1)
If NumRows < 1 Or NumRows > 1048576 Then
Beep
Exit Sub
End If
Application.ScreenUpdating = False
For i = 1 To NumSheets
Wsh.Range("A2").Resize(NumRows).Value = "This"
Wsh.Range("B2").Resize(NumRows).Value = "That"
Wsh.Range("C2").Resize(NumRows).Formula = "=BASE(ROW()-2+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
Wsh.Range("D2").Resize(NumRows).Value = "Other"
Wsh.Range("E2").Resize(NumRows).Value = "Something"
Wsh.Range("A" & NumRows + 2 & ":E" & NumRows + 2).Value = Array("Footer 1", "Footer 2", "Footer 3", "Footer 4", "Footer 5")
DoEvents
Next i
Wbk.Worksheets(1).Delete
Application.ScreenUpdating = True
End Sub

Sub SaveToText()
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim NumRows As Long
Dim Filename As Variant
Dim f As Integer
Dim r As Long
Filename = Application.GetSaveAsFilename(FileFilter:="Text File (*.txt),*.txt", Title:="Save to Text File")
If Filename = False Then
Exit Sub
End If
f = FreeFile
Open Filename For Output As #f
Set Wbk = ActiveWorkbook
For Each Wsh In Wbk.Worksheets
NumRows = Wsh.Range("C" & Wsh.Rows.Count).End(xlUp).Row
For r = 1 To NumRows
Print #f, Wsh.Range("C" & r).Text
Next r
Next Wsh
Close #f
End Sub``````