Type Mismatch

[Thommo1982]

Hi

I am using a macro that was written by somebody else to automatically create a CSV file.

For some reason I am now getting a Type Mismatch when I try to include the 7th sheet.

It was originally created for 6 sheets. There is an option to exclude any of the sheets when creating the CSV.

I have spent hours trying to figure out what is going on.

Any help would be very much appreciated.

Here is the macro:


Private Type Cols
Colname As String
Coltype As Integer
Colvalue As String
End Type
Sub ExportCSV()
Dim NumSheets As Long
Dim ColRange As String
Dim FileName As String
Dim SheetName As String
Dim IgnoreCol As String
Dim KeyCol As String
Dim tmpLine As String
Dim tmpCSVFile As String
Dim tmpValue As String
Dim tmpKEY As String
Dim tmpOPTIONS As String
Dim tmpOPTSplit() As String
Dim optLine As String

Dim Columns() As Cols
Dim DoExport As Boolean


NumSheets = Sheets("!EXPORT!").Range("B3").Value
ColRange = Replace(Sheets("!EXPORT!").Range("B4").Formula, "=", "")
FileName = Sheets("!EXPORT!").Range("B5").Value

ReDim Columns(Sheets("!EXPORT!").Range(ColRange).Columns.Count - 1)

tmpLine = ""
For ch = 0 To UBound(Columns())
With Columns(ch)
.Colname = Sheets("!EXPORT!").Range(ColRange).Cells(1, ch + 1)
If .Colname = "SHEET" Then .Coltype = 1
If .Colname = "IGNORE" Then .Coltype = 2
If InStr(.Colname, "KEY:") Then .Coltype = 3: .Colname = Replace(.Colname, "KEY:", "")
If InStr(.Colname, "STR:") Then .Coltype = 6: .Colname = Replace(.Colname, "STR:", "")
If InStr(.Colname, "VAL:") Then .Coltype = 7: .Colname = Replace(.Colname, "VAL:", "")
If InStr(.Colname, "CON:") Then .Coltype = 8: .Colname = Replace(.Colname, "CON:", "")
If InStr(.Colname, "OPT:") Then .Coltype = 10: .Colname = Replace(.Colname, "OPT:", "")
If .Coltype >= 3 Then tmpLine = tmpLine + .Colname + ","
End With
Next ch
tmpLine = Left(tmpLine, Len(tmpLine) - 1) + vbCrLf
tmpCSVFile = tmpCSVFile + tmpLine
tmpLine = ""

For r = 2 To 1 + NumSheets
DoExport = False
'Start processing sheets
For ch = 0 To UBound(Columns())
With Columns(ch)
.Colvalue = Sheets("!EXPORT!").Range(Replace(ColRange, "1", r)).Cells(1, ch + 1)
If .Coltype = 1 Then SheetName = .Colvalue
If .Coltype = 2 Then IgnoreCol = .Colvalue
If .Coltype = 6 And .Colvalue = "" Then .Coltype = 8
If .Coltype = 7 And .Colvalue = "" Then .Coltype = 8
If .Colname = "EXPORT" And .Colvalue <> "" Then DoExport = True
End With
Next ch

If DoExport = False Then GoTo SkipImport

For sr = 1 To FindLastRow(SheetName)
tmpKEY = ""
tmpLine = ""
tmpOPTIONS = ""
optLine = ""
tmpValue = ""
For ch = 0 To UBound(Columns())
With Columns(ch)
Select Case .Coltype
Case 1:
Case 2: If Sheets(SheetName).Range(.Colvalue & sr).Value <> "" Then GoTo SkipLine
Case 3: tmpValue = Trim(Sheets(SheetName).Range(.Colvalue & sr).Value): tmpKEY = tmpValue
Case 6: tmpValue = Trim(Sheets(SheetName).Range(.Colvalue & sr).Value)
Case 7: tmpValue = Trim(Round(Sheets(SheetName).Range(.Colvalue & sr).Value, 2))
Case 8: tmpValue = .Colvalue
Case 10: tmpValue = Trim(Sheets(SheetName).Range(.Colvalue & sr).Value): tmpOPTIONS = tmpValue
End Select
If .Coltype > 2 Then
tmpLine = tmpLine & tmpValue & ","
End If
End With
Next ch

If tmpKEY = "" Then GoTo SkipLine
tmpLine = Left(tmpLine, Len(tmpLine) - 1) & vbCrLf
tmpCSVFile = tmpCSVFile + tmpLine
optLine = tmpLine

If tmpOPTIONS > "" Then
tmpOPTSplit() = Split(tmpOPTIONS, "|")
For o = 0 To UBound(tmpOPTSplit())
tmpLine = Replace(optLine, tmpKEY, tmpKEY & tmpOPTSplit(o))
tmpCSVFile = tmpCSVFile + tmpLine
Next o
End If



SkipLine:
Next sr
SkipImport:
Next r


Open FileName For Output As #1
Print #1, tmpCSVFile
Close #1
MsgBox "Number of Sheets: " & NumSheets & ", Column Range: " & ColRange & ". RANGE DATA: " & Sheets("!EXPORT!").Range("D1:S1").Cells(1, 1) & ".", vbInformation, "Export Completed!"




End Sub
Function FindLastRow(sheet As String) As Long

Dim LastRow As Long

If WorksheetFunction.CountA(Cells) > 0 Then

'Search for any entry, by searching backwards by Rows.

LastRow = Sheets(sheet).Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

FindLastRow = LastRow

End If
End Function