Hi,

I'm hoping someone could help me fix a Macro that is giving us problems.

The Macro is probably badly written in parts (well the parts I have added
anyway) because my VBA knowledge is poor at best.

Basically the Macro imports a large csv file, converts the imported data to
columns, takes out unique rows and then does some formula's on an exisiting
worksheet to give us some figures before deleting the sheets created by the
csv file import.

This has always worked fine because the import has always created 2
worksheets, never any more, never any less. Now we have a problem where
sometimes we are getting more or less than 2 worksheets and the Macro falls
over when this happens.

Could someone please help in changing this so it will work regardless of the
number of worksheets created by the file import?

THe Macro is shown below...


--------
Sub FileImport()

'Dimension Variables

Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim Counter As Double

'Filename for Txt file
FileName = "\\Hdqfs001\public_hdq014-fs02\Revenue
Accounts\REVERA\Systems_analysis\JD_month_end_repo rts\Trans volumes per card
type.txt"

'Get Next Available File Handle Number
FileNum = FreeFile()

'Open Text File For Input
Open FileName For Input As #FileNum

'Turn Screen Updating Off
Application.ScreenUpdating = False

'Create A New Worksheet
ActiveWorkbook.Sheets.Add

'Set The Counter to 1
Counter = 1

'Loop Until the End Of File Is Reached
Do While Seek(FileNum) <= LOF(FileNum)

'Display Importing Row Number On Status Bar
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName

'Store One Line Of Text From File To Variable
Line Input #FileNum, ResultStr

'Store Variable Data Into Active Cell
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If

'If on the last row of worksheet create a new worksheet
If ActiveCell.Row = 65536 Then
ActiveWorkbook.Sheets.Add
Else
'If Not The Last Row Then Go One Cell Down
ActiveCell.Offset(1, 0).Select
End If

'Increment the Counter By 1
Counter = Counter + 1

'Start Again At Top Of 'Do While' Statement
Loop

'Close The Open Text File
Close

'Remove Message From Status Bar
Application.StatusBar = False

'Select the first column of the first worksheet created
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select

'Convert the imported text rows to columns
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'Delete the columns we do not need
Range("B1:C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireColumn.Delete
Range("C1:E1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireColumn.Delete

'Insert a row on sheet2 for headers
Range("A1:D1").Select
Selection.EntireRow.Insert

'Select the first column of the other created worksheet
Range("A1").Select
ActiveSheet.Next.Select

'Convert the text rows to columns
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

'delete the rows we do not need
Range("B1:C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
Range("C1:E1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
Range("A1:D1").Select
Range(Selection, Selection.End(xlDown)).Select

'filter out the duplicated data from the imported data
Columns("A:D").AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Columns( _
"F:I"), Unique:=True
Range("A1:E1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveSheet.Previous.Select
Range("A1").Select
ActiveSheet.Paste
Range("A1:D1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Range("A1:D26110").AdvancedFilter Action:=xlFilterCopy, CopyToRange:= _
Columns("F:I"), Unique:=True
Range("A1:E1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireColumn.Delete
Range("A1").Select
ActiveSheet.Next.Select
ActiveSheet.Next.Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(3).Select
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(1).Select
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveWindow.Visible = False
Windows("Transaction Volumes by Card Type Template.xls").Activate


Range("C4").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
Loop

Selection.EntireColumn.Insert
Application.CutCopyMode = False
ActiveSheet.Previous.Select
Range("A2").Select
Selection.Copy
ActiveSheet.Next.Select
Range("C4").Select

'find the next empty cell in row
Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
Loop

ActiveSheet.Paste
Application.CutCopyMode = False

With Selection.Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 49
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

Selection.Copy
ActiveCell.Offset(36, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveCell.Offset(-31, -1).Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveCell.Offset(-4, 0).Select
ActiveCell.FormulaR1C1 =
"=SUM(COUNTIF(Sheet1!R2C3:R65536C3,R5C2))+(COUNTIF (Sheet2!R2C3:R65536C3,R5C2))"
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 =
"=SUM(COUNTIF(Sheet1!R2C3:R65536C3,R6C2))+(COUNTIF (Sheet2!R2C3:R65536C3,R6C2))"


'Replace the formulas with actual values
Range("B5").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(0, -1).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(1, 0).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

'Delete the Worksheets
ActiveSheet.Previous.Select
ActiveWindow.SelectedSheets.Delete
ActiveSheet.Previous.Select
ActiveWindow.SelectedSheets.Delete

Range("B41").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
Loop

ActiveCell.Offset(0, -1).Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste

ActiveCell.Offset(1, -1).Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste

End Sub


--------

Any help would be very much appreciated.

Regards
John