VBA: Select Contiguous Values and Save As Text

[lneidorf]

Hi there.

I've got a VBA macro that I adapted from @Fluff here (thank you!).

Here's my edited code:

Sub SaveAsTextFiles1()
'https://www.mrexcel.com/board/threads/select-contiguous-values-in-col-a.1089184/
   Dim Cl As Range
   Dim ws As Worksheet
   Dim Ky As Variant
  
Application.DisplayAlerts = False 'Suppresses clipboard warning message
Application.ScreenUpdating = False 'Prevents flickering of screen / change of focus
Application.Calculation = xlCalculationManual 'Turns off calculations while code runs
  
   Set ws = Sheets("sheet1")
   With CreateObject("scripting.dictionary")
      For Each Cl In ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp))
         If Not .Exists(Cl.Value) Then .Add Cl.Value, Nothing
      Next Cl
      For Each Ky In .Keys
         ws.Copy
         Range("A1:I1").AutoFilter 1, "<>" & Ky
         ActiveSheet.AutoFilter.Range.Offset(1).EntireRow.Delete
         Range("A1:I1").AutoFilter
         ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Ky, 20
         ActiveWorkbook.Close False
      Next Ky
   End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Beep
MsgBox "Congratulations!" & vbNewLine & vbNewLine & "Your macro has completed."

End Sub

Given the volume of work I need to do, I need something that runs more quickly.

In a nutshell, I've got a series of CSV exports that I'm trying to break up and save as text files. Column A contains a ThreadID value that repeats. Rows are clustered by ThreadID. I'm trying to select all contiguous rows bearing the same ThreadID and save those as a single Text file named by that ThreadID. Columns A:I are populated with data and that's what I'm looking to save in those text files.

@Fluff 's code works great. But I'll need to process 200-250 CSV files, some of which have thousands of ThreadID clusters. Based upon my tests of the existing code, it will take over a week to execute across dozens of source CSV files.

Any suggestions on how to speed things up? Open to alternate code.

Thanks!

 

[DanteAmor]

Column A contains a ThreadID value that repeats.

The data is ordered by column A?

 

[lneidorf]

The data is ordered by column A?

Indeed it is! To be clear, I've got 65,000 rows. Column A contains Thread ID values, which repeat to identify rows that are part of the same thread. I believe I've got around 7,500 unique Thread ID values here. And so the idea is to combine the rows bearing the same Thread ID value and save in text files named by Thread ID value.

Thanks!

 

[DanteAmor]

Indeed it is!

So if they are sorted by column A, by Thread ID, then try the following.
You can comment on how long the previous process took and how long it takes now with this macro.

Sub SaveAs_TextFiles_1()
  Dim sPath As String, cad As String, tit As String
  Dim a As Variant, ant As Variant
  Dim i As Long, j As Long
  '
  sPath = ThisWorkbook.Path & "\"
  a = Range("A2:I" & Range("A" & Rows.Count).End(xlUp).Row).Value
  '
  ant = a(1, 1)
  Open sPath & ant & ".txt" For Output As #1
  For j = 1 To 9
    tit = tit & Cells(1, j).Value & vbTab
  Next j
  tit = Left(tit, Len(tit) - 1)
  Print #1, tit
  '
  For i = 1 To UBound(a, 1)
    If ant <> a(i, 1) Then
      Close #1
      Open sPath & a(i, 1) & ".txt" For Output As #1
      Print #1, tit
    End If
    For j = 1 To 9
      cad = cad & a(i, j) & vbTab
    Next j
    cad = Left(cad, Len(cad) - 1)
    Print #1, cad
    cad = Empty
    ant = a(i, 1)
  Next i
  '
  Close #1
  Beep
  MsgBox "Congratulations!" & vbNewLine & vbNewLine & "Your macro has completed."
End Sub