Excel 2002 VBA Type Mismatch

[William Loh]

Hi,

Currently, I am generating a macro program which is capable of converting csv to xls format. Following this, unwanted rows and columns will be deleted and columns that contain cells with certain text strings will be highlighted for ease of differentiation.

However, I encountered Run-time error '13': Type mismatch in the following line.
"LR = Cells.Find(What:="*", After:=[a1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row".
This line is located towards the end of the program.

The codes that I've wrote is as follows below.
Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdOK_Click()

Dim Filename As String

'If view data in csv format option is selected
If optCSV = True Then
Filename = InputBox("Please type in the full path and name to the csv file. eg C:\test.csv")
If Len(Filename) > 0 Then
Open Filename For Input As #1
Close #1
End If
Workbooks.Open Filename

'If view data in xls format option is selected
ElseIf optXLS = True Then
Filename = InputBox("Please type in the full path and name to the csv file. eg C:\test.csv for conversion to xls format")
If Len(Filename) > 0 Then
Open Filename For Input As #1
Close #1
End If

'Perform data importing
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Filename, _
Destination:=Range("A1"))

.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

'Save imported data to C drive
'ActiveWorkbook.SaveAs Filename:="C:\imported data.xls", FileFormat:=xlExcel5, _
'Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
'CreateBackup:=False

'Delete entire row if it contains an empty cell in column A
Dim i As Long, LastRow As Long
Application.ScreenUpdating = False
'Locate last used row in column A
LastRow = Range("A65536").End(xlUp).Row
'Check each row for column A that contains a blank cell
For i = LastRow To 1 Step -1
If Cells(i, "A") = "" Then Rows(i).Delete
Next i
Application.ScreenUpdating = True

'Delete entire row if the cell contains CSV in column A
Dim a0 As Range
Dim SrchRng0
Set SrchRng0 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a0 = SrchRng0.Find("CSV", LookIn:=xlValues)
If Not a0 Is Nothing Then a0.EntireRow.Delete
Loop While Not a0 Is Nothing

'Delete entire row if the cell contains 00: in column A
Dim a1 As Range
Dim SrchRng1
Set SrchRng1 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a1 = SrchRng1.Find("00:", LookIn:=xlValues)
If Not a1 Is Nothing Then a1.EntireRow.Delete
Loop While Not a1 Is Nothing

'Delete entire row if the cell contains 01: in column A
Dim a2 As Range
Dim SrchRng2
Set SrchRng2 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a2 = SrchRng2.Find("01:", LookIn:=xlValues)
If Not a2 Is Nothing Then a2.EntireRow.Delete
Loop While Not a2 Is Nothing

'Delete entire row if the cell contains 02: in column A
Dim a3 As Range
Dim SrchRng3
Set SrchRng3 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a3 = SrchRng3.Find("02:", LookIn:=xlValues)
If Not a3 Is Nothing Then a3.EntireRow.Delete
Loop While Not a3 Is Nothing

'Delete entire row if the cell contains 03: in column A
Dim a4 As Range
Dim SrchRng4
Set SrchRng4 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a4 = SrchRng4.Find("03:", LookIn:=xlValues)
If Not a4 Is Nothing Then a4.EntireRow.Delete
Loop While Not a4 Is Nothing

'Delete entire row if the cell contains 04: in column A
Dim a5 As Range
Dim SrchRng5
Set SrchRng5 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a5 = SrchRng5.Find("04:", LookIn:=xlValues)
If Not a5 Is Nothing Then a5.EntireRow.Delete
Loop While Not a5 Is Nothing

'Delete entire row if the cell contains 05: in column A
Dim a6 As Range
Dim SrchRng6
Set SrchRng6 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a6 = SrchRng6.Find("05:", LookIn:=xlValues)
If Not a6 Is Nothing Then a6.EntireRow.Delete
Loop While Not a6 Is Nothing

'Delete entire row if the cell contains 06: in column A
Dim a7 As Range
Dim SrchRng7
Set SrchRng7 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a7 = SrchRng7.Find("06:", LookIn:=xlValues)
If Not a7 Is Nothing Then a7.EntireRow.Delete
Loop While Not a7 Is Nothing

'Delete entire row if the cell contains 20: in column A
Dim a8 As Range
Dim SrchRng8
Set SrchRng8 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a8 = SrchRng8.Find("20:", LookIn:=xlValues)
If Not a8 Is Nothing Then a8.EntireRow.Delete
Loop While Not a8 Is Nothing

'Delete entire row if the cell contains 21: in column A
Dim a9 As Range
Dim SrchRng9
Set SrchRng9 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a9 = SrchRng9.Find("21:", LookIn:=xlValues)
If Not a9 Is Nothing Then a9.EntireRow.Delete
Loop While Not a9 Is Nothing

'Delete entire row if the cell contains 22: in column A
Dim a10 As Range
Dim SrchRng10
Set SrchRng10 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a10 = SrchRng10.Find("22:", LookIn:=xlValues)
If Not a10 Is Nothing Then a10.EntireRow.Delete
Loop While Not a10 Is Nothing

'Delete entire row if the cell contains 23: in column A
Dim a11 As Range
Dim SrchRng11
Set SrchRng11 = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))
Do
Set a11 = SrchRng11.Find("23:", LookIn:=xlValues)
If Not a11 Is Nothing Then a11.EntireRow.Delete
Loop While Not a11 Is Nothing

'Delete entire column if the cell contains OpTm in Row A1
Dim a12 As Range
Dim SrchRng12
Set SrchRng12 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a12 = SrchRng12.Find("OpTm", LookIn:=xlValues)
If Not a12 Is Nothing Then a12.EntireColumn.Delete
Loop While Not a12 Is Nothing

'Delete entire column if the cell contains Fac in Row A1
Dim a13 As Range
Dim SrchRng13
Set SrchRng13 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a13 = SrchRng13.Find("Fac", LookIn:=xlValues)
If Not a13 Is Nothing Then a13.EntireColumn.Delete
Loop While Not a13 Is Nothing

'Delete entire column if the cell contains Fehler in Row A1
Dim a14 As Range
Dim SrchRng14
Set SrchRng14 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a14 = SrchRng14.Find("Fehler", LookIn:=xlValues)
If Not a14 Is Nothing Then a14.EntireColumn.Delete
Loop While Not a14 Is Nothing

'Delete entire column if the cell contains h-On in Row A1
Dim a15 As Range
Dim SrchRng15
Set SrchRng15 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a15 = SrchRng15.Find("h-On", LookIn:=xlValues)
If Not a15 Is Nothing Then a15.EntireColumn.Delete
Loop While Not a15 Is Nothing

'Delete entire column if the cell contains h-Total in Row A1
Dim a16 As Range
Dim SrchRng16
Set SrchRng16 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a16 = SrchRng16.Find("h-Total", LookIn:=xlValues)
If Not a16 Is Nothing Then a16.EntireColumn.Delete
Loop While Not a16 Is Nothing

'Delete entire column if the cell contains Netz-Ein in Row A1
Dim a17 As Range
Dim SrchRng17
Set SrchRng17 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a17 = SrchRng17.Find("Netz-Ein", LookIn:=xlValues)
If Not a17 Is Nothing Then a17.EntireColumn.Delete
Loop While Not a17 Is Nothing

'Delete entire column if the cell contains Riso in Row A1
Dim a18 As Range
Dim SrchRng18
Set SrchRng18 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a18 = SrchRng18.Find("Riso", LookIn:=xlValues)
If Not a18 Is Nothing Then a18.EntireColumn.Delete
Loop While Not a18 Is Nothing

'Delete entire column if the cell contains Seriennummer in Row A1
Dim a19 As Range
Dim SrchRng19
Set SrchRng19 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a19 = SrchRng19.Find("Seriennummer", LookIn:=xlValues)
If Not a19 Is Nothing Then a19.EntireColumn.Delete
Loop While Not a19 Is Nothing

'Delete entire column if the cell contains Status in Row A1
Dim a20 As Range
Dim SrchRng20
Set SrchRng20 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a20 = SrchRng20.Find("Status", LookIn:=xlValues)
If Not a20 Is Nothing Then a20.EntireColumn.Delete
Loop While Not a20 Is Nothing

'Delete entire column if the cell contains Zac in Row A1
Dim a21 As Range
Dim SrchRng21
Set SrchRng21 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a21 = SrchRng21.Find("Zac", LookIn:=xlValues)
If Not a21 Is Nothing Then a21.EntireColumn.Delete
Loop While Not a21 Is Nothing

'Delete entire column if Display ExlSollrr checkbox is not checked
Dim a22 As Range
Dim SrchRng22

If chkDis_ExlSollrr = False Then
Set SrchRng22 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a22 = SrchRng22.Find("Exl", LookIn:=xlValues)
If Not a22 Is Nothing Then a22.EntireColumn.Delete
Loop While Not a22 Is Nothing
End If

'Delete entire column if Display IntSollrr checkbox is not checked
Dim a23 As Range
Dim SrchRng23

If chkDis_IntSollrr = False Then
Set SrchRng23 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a23 = SrchRng23.Find("Int", LookIn:=xlValues)
If Not a23 Is Nothing Then a23.EntireColumn.Delete
Loop While Not a23 Is Nothing
End If

'Delete entire column if Display TmpAmb checkbox is not checked
Dim a24 As Range
Dim SrchRng24

If chkDis_TmpAmb = False Then
Set SrchRng24 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a24 = SrchRng24.Find("TmpAmb", LookIn:=xlValues)
If Not a24 Is Nothing Then a24.EntireColumn.Delete
Loop While Not a24 Is Nothing
End If

'Delete entire column if Display TmpMdul checkbox is not checked
Dim a25 As Range
Dim SrchRng25

If chkDis_TmpMdul = False Then
Set SrchRng25 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a25 = SrchRng25.Find("TmpMdul", LookIn:=xlValues)
If Not a25 Is Nothing Then a25.EntireColumn.Delete
Loop While Not a25 Is Nothing
End If

'Delete entire column if Display WindVel checkbox is not checked
Dim a26 As Range
Dim SrchRng26

If chkDis_WindVel = False Then
Set SrchRng26 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a26 = SrchRng26.Find("WindVel", LookIn:=xlValues)
If Not a26 Is Nothing Then a26.EntireColumn.Delete
Loop While Not a26 Is Nothing
End If

'Delete entire column if Display Upv-Soll checkbox is not checked
Dim a27 As Range
Dim SrchRng27

If chkDis_Upv = False Then
Set SrchRng27 = ActiveSheet.Range("A1", ActiveSheet.Range("IV1").End(xlToLeft))
Do
Set a27 = SrchRng27.Find("Soll", LookIn:=xlValues)
If Not a27 Is Nothing Then a27.EntireColumn.Delete
Loop While Not a27 Is Nothing
End If

'Highlighting of columns containing certain text strings
Application.ScreenUpdating = False
Dim LR As Long
Dim LC As Integer
Dim ColorRange As Range
Dim cell As Range

LR = Cells.Find(What:="*", After:=[a1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = Cells.Find(What:="*", After:=[a1], SearchOrder:=xlByColumns, SearchDirection:=xlPrvious).Column
Set ColorRange = Range(Cells(1, 1), Cells(LR, LC))
ColorRange.Interior.ColorIndex = 0
For Each cell In ColorRange.SpecialCells(2)
With cell.Interior
Select Case True
Case cell.Value = "ExlSolIrr"
cell.EntireColumn.Interior.ColorIndex = 34
Case cell.Value = "IntSolIrr"
cell.EntireColumn.Interior.ColorIndex = 34
Case cell.Value = "TmpAmb C"
cell.EntireColumn.Interior.ColorIndex = 34
Case cell.Value = "TmpMdul C"
cell.EntireColumn.Interior.ColorIndex = 34
Case cell.Value = "WindVel m/s"
cell.EntireColumn.Interior.ColorIndex = 34
End Select
End With
Next cell
Application.ScreenUpdating = True

End If

End Sub


I would be very grateful if someone is able to clear the air on this issue, thanks in advance.

William Loh