SOLVED

....

Copper Contributor
27 Replies

@AlremeithiMohamed 

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.

..........

@AlremeithiMohamed 

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.

..........

@AlremeithiMohamed 

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.

..........

@AlremeithiMohamed 

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
    Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
    For i = 1 To NumSheets
        Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
        With Wsh.Range("A1:A" & NumRows)
            .Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
        End With
        DoEvents
    Next i
    Application.DisplayAlerts = False
    Wbk.Worksheets(1).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

..........

..........

..........

@AlremeithiMohamed 

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
    Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
    For i = 1 To NumSheets
        Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
        With Wsh.Cells(1, Col).Resize(NumRows)
            .Formula = "=BASE(ROW()-1+" & (i - 1) * NumRows & "," & 10 + NumLetters & ", 6)"
        End With
        DoEvents
    Next i
    Application.DisplayAlerts = False
    Wbk.Worksheets(1).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

@AlremeithiMohamed 

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
    Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
    For i = 1 To NumSheets
        Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
        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
    Application.DisplayAlerts = False
    Wbk.Worksheets(1).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

..........

best response confirmed by AlremeithiMohamed (Copper Contributor)
Solution

@AlremeithiMohamed 

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
    Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
    For i = 1 To NumSheets
        Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
        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
    Application.DisplayAlerts = False
    Wbk.Worksheets(1).Delete
    Application.DisplayAlerts = True
    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

..........

..........

@AlremeithiMohamed 

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
    Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
    For i = 1 To NumSheets
        Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
        Wsh.Range("A1:E1").Value = Array("Header 1", "Header 2", "Header 3", "Header 4", "Header 5")
        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
    Application.DisplayAlerts = False
    Wbk.Worksheets(1).Delete
    Application.DisplayAlerts = True
    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

..........

@AlremeithiMohamed 

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
    Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
    For i = 1 To NumSheets
        Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
        Wsh.Range("A1:E1").Value = Array("Header 1", "Header 2", "Header 3", "Header 4", "Header 5")
        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
    Application.DisplayAlerts = False
    Wbk.Worksheets(1).Delete
    Application.DisplayAlerts = True
    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
1 best response

Accepted Solutions
best response confirmed by AlremeithiMohamed (Copper Contributor)
Solution

@AlremeithiMohamed 

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
    Set Wbk = Workbooks.Add(Template:=xlWBATWorksheet)
    For i = 1 To NumSheets
        Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worksheets(Wbk.Worksheets.Count))
        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
    Application.DisplayAlerts = False
    Wbk.Worksheets(1).Delete
    Application.DisplayAlerts = True
    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

View solution in original post