Dim Criteria As Range, myRng As Range
Sub test()
Dim cell As Range
Application.ScreenUpdating = False
With Sheets("Sheet3")
'turns off autofilter if it is on
If .AutoFilterMode = True Then .AutoFilterMode = False
'range of data, not including header row (data starts in row 2)
Set myRng = .Range("A2", .Range("A65536").End(xlUp))
'filter column A to show unique items (1 instance of each entry)
.Columns("A:A").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
'set filtered results as range
Set Criteria = myRng.SpecialCells(xlCellTypeVisible)
'remove filter
ActiveSheet.ShowAllData
With .Rows("1:1")
.AutoFilter 'turn on autofilter
For Each cell In Criteria
'filter column A using criteria
.AutoFilter field:=1, Criteria1:=cell.Value
'call the Export macro
Sheets("Sheet1").Range("A2:B600").ClearContents
Call Export
Next cell 'display filter results for next item
.AutoFilter 'turn off autofilter
End With
End With
Application.ScreenUpdating = True
End Sub
Sub Export()
Dim Textfile As Variant
Dim XportArea As Range, Cel As Range
Dim i As Long, iCol As Long, iRow As Long
Dim LastRow As Long, iFnum As Integer, x As Integer
Dim Path As String, FileName As String
Dim SaveFile As String, ShName As Variant
'copy visible cells in columns A:B of sheet 3 (filtered results)
myRng.SpecialCells(xlCellTypeVisible).Copy
'paste to Sheet1
Sheets("Sheet1").Range("A2").PasteSpecial xlPasteValues
Path = "C:\test\"
Textfile = Sheets("Sheet1").Range("A2").Value
FileName = LCase(Replace(Textfile, " ", ""))
SaveFile = Path & FileName & ".txt"
If Textfile = False Then Exit Sub
On Error Resume Next
'open / create the textfile
iFnum = FreeFile
Open CStr(SaveFile) For Append As iFnum
'since you're performing the same thing these sheets, _
you can turn this into a loop
ShName = Array("Output#1", "Output#2", "Output#3", "Output#4", "Output#5")
For x = LBound(ShName) To UBound(ShName)
If ShName(x) = "Output#4" Then
' Get number of columns value from sheet 1
i = Sheets("Sheet1").Range("C2").Value
Set XportArea = Sheets(ShName(x)).Range("B1").Resize(5, i)
Else
'Select the cells to export:
With Sheets(ShName(x))
.Activate
Set XportArea = .Range([a1], .[A65536].End(xlUp))
End With
End If
For iCol = 1 To XportArea.Columns.Count
For iRow = 1 To XportArea.Rows.Count
If XportArea.Cells(iRow, iCol).Text <> "" Then
Print #iFnum, XportArea.Cells(iRow, iCol).Text
Debug.Print XportArea.Cells(iRow, iCol).Text
End If
Next iRow
Next iCol
Next x
Close #iFnum
End Sub
