How to add a dialog box to specify range instead of having hardcoded range in vba?

[PeeterP]

Hi, i have a macro that takes 1000 rows from top and save's them as as a new file, i then repeat the ,macro to take another 1k rows and save it into new file with automatically appended number in the filename, then i manually repeat the macro until i have separated all rows and there are no more left.

I'd like to have a dialog box where i can specify different number of rows to be saved into the files instead of going to change the vba code when i need different number of rows. Number of rows must be the same for all saved files.

Also need some tweak for this vba to make it repeating itself until the end of column so that all the rows will be separated into the files.

Would you guys help me out with this please?

Here is my macro:

Function FileThere(FileName As String) As Boolean
    FileThere = (Dir(FileName) > "")
End Function
 
Sub CreateCSV()
    Sheets("Sheet1").Select
    Range("A1:A1000").Select
    Selection.Cut
        Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets("article")
    If Err.Number = 9 Then
        Set ws = Worksheets.Add(After:=Sheets(Worksheets.Count))
        ws.Name = "article"
    End If
    With ws
        'do stuff
    End With
    Sheets("article").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Selection.Delete Shift:=xlUp
    Sheets("article").Select
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Dim recordnumber As Integer
    Dim journalref As String
    Dim filenamea As String
    
    journalref = "article"
    filenamea = journalref & ".txt"
          
 '// A temporary variable
Dim iTemp As Integer
 
 '// Now determine the filename
filenamea = journalref
 
 '// The ".CSV" has been split from the filename to
 '// make the logic easier to code - so that means
 '// it has to be added back in when doing DIR and Saving
 '// Check if the file exists...
 '// If it does, it'll fall into the Do...Loop
 '// Otherwise it'll continue after the LOOP statement
Do While Dir(filenamea & ".txt") <> vbNullString
     '// If it does, then append a _00 to the name
    filenamea = journalref & Format$(iTemp, "_00")
     
     '// Increment the counter
    iTemp = iTemp + 1
     
     '// and go around again
Loop
 
 '// Save the file - Remember need to append .CSV to the filename
ActiveWorkbook.SaveAs FileName:=filenamea & ".txt", _
FileFormat:=xlTextWindows, CreateBackup:=False
 '// End of changes
 '// ********************************************************

    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete

End Sub

NOTE: I don't know much about VBA codes/language all i have in that VBA is just what i found on internet and put it together to make it work for my needs.

 

[My Aswer Is This]

Are you trying to take 1000 rows and paste into new Worksheet or New Workbook?

 

[Gestel]

Hi Peter,

I googled around a bit and might have found a solution that works concerning the number of rows.
you should be able to specify the amount of rows to select in cell F2 in Sheet1 with this code.

Untested:

Function FileThere(FileName As String) As Boolean
    FileThere = (Dir(FileName) > "")
End Function
 
Sub CreateCSV()
    Sheets("Sheet1").Select
Dim Cval As Variant
Dim Rng1 As Range
Cval=Activesheet.Range("F2")
Set Rng1= Actiesheet.range("A1:A"&Cval)
    Rng1.Select
    Selection.Cut
        Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets("article")
    If Err.Number = 9 Then
        Set ws = Worksheets.Add(After:=Sheets(Worksheets.Count))
        ws.Name = "article"
    End If
    With ws
        'do stuff
    End With
    Sheets("article").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Selection.Delete Shift:=xlUp
    Sheets("article").Select
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Dim recordnumber As Integer
    Dim journalref As String
    Dim filenamea As String
    
    journalref = "article"
    filenamea = journalref & ".txt"
          
 '// A temporary variable
Dim iTemp As Integer
 
 '// Now determine the filename
filenamea = journalref
 
 '// The ".CSV" has been split from the filename to
 '// make the logic easier to code - so that means
 '// it has to be added back in when doing DIR and Saving
 '// Check if the file exists...
 '// If it does, it'll fall into the Do...Loop
 '// Otherwise it'll continue after the LOOP statement
Do While Dir(filenamea & ".txt") <> vbNullString
     '// If it does, then append a _00 to the name
    filenamea = journalref & Format$(iTemp, "_00")
     
     '// Increment the counter
    iTemp = iTemp + 1
     
     '// and go around again
Loop
 
 '// Save the file - Remember need to append .CSV to the filename
ActiveWorkbook.SaveAs FileName:=filenamea & ".txt", _
FileFormat:=xlTextWindows, CreateBackup:=False
 '// End of changes
 '// ********************************************************

    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete

End Sub

 

[PeeterP]

Thanks Gastel, that helped me to finish all i needed to do. (sorry for the late reply)