Jump to content
Xtreme .Net Talk

Recommended Posts

Posted (edited)

This is odd I am getting Bad Variable Type exception in the line: oXL.WorksheetFunction.CountA(rng.Rows(i)) = 0 Then

 

However, the line:

oXL.WorksheetFunction.Sum(ws.Range(ws.Cells(i, colNumStart), ws.Cells(i, lastCol)))
is executed before the first... and it works fine.

 

here are the lines that call the class functions:

Dim oSheet As Excel.Worksheet
Dim oXL As Excel.Application
' Create Excel objects
oXL = New Excel.Application()
Dim oWB As Excel.Workbook
' Open file
oWB = oXL.Workbooks.Open(fileToFormat)
oSheet = oWB.ActiveSheet
Dim oGenFuncs As New EAL_Format.generalFormatFunctions(oSheet, oXL)
Call oGenFuncs.generalFormat()
.
.
.
Call oGenFuncs.GetUsedRange(lastRow, lastCol)

the call to oXL.WorksheetFunction works fine in the first call....(though they are different functions one is Sum and the other is CountA...)

 

Have any ideas of why Iam getting the Bad Variable Type error? Also if you have any suggestions for my code in general I would appreciate it.

 

 

 

 

 

 

 

Here is my class:

Public Class generalFormatFunctions

   Private ws As Excel.Worksheet
   Private oXL As Excel.Application

   Sub New(ByRef worksheet As Excel.Worksheet, ByRef excel As Excel.Application)
       ws = worksheet
       oXL = excel
   End Sub

   Public Function generalFormat()
       '
       ' generalFormat Macro
       ' Macro recorded 1/31/2003 by Andre de Araujo Jorge
       ' performs general required formating to both income and market value files

       '   Delete left three and Up 50 and Down 50 cols

       ws.Columns("A:C").Delete()
       ws.Columns("E").Delete()
       ws.Columns("F").Delete()

       ' Divide all numerical cells by 1000
       Dim cellType As Excel.XlCellType
       Dim pasteType As Excel.XlPasteSpecialOperation
       Dim pstVals As Excel.XlPasteType
       Dim numFormat As Excel.XlPasteSpecialOperation
       pasteType = Excel.XlPasteSpecialOperation.xlPasteSpecialOperationDivide
       pstVals = Excel.XlPasteType.xlPasteValues
       cellType = Excel.XlCellType.xlCellTypeConstants
       ws.Range("J9").Value = 1000
       ws.Range("J9").Copy()
       ws.Range("B:H").SpecialCells(cellType).PasteSpecial(pstVals, pasteType)
       ws.Range("B:H").SpecialCells(cellType).NumberFormat() = 0
       ws.Range("J9").Clear()

       Call DeleteInvalidRows()

   End Function

   Public Function DeleteInvalidRows()
       Dim colNumStart As Integer = 2
       'Dim wsFuncs As Excel.WorksheetFunction
       'wsFuncs = New Excel.WorksheetFunction()
       'wsFuncs = oXL.WorksheetFunction
       'Delete all rows that have 0 sum - assuming numbers start in col 2
       Dim lastCol = ws.UsedRange.Columns.Count
       Dim i As Integer
       Dim sumTotal As Double
       For i = ws.UsedRange.Rows.Count To 1 Step -1
           If oXL.WorksheetFunction.Sum(ws.Range(ws.Cells(i, colNumStart), ws.Cells(i, lastCol))) = 0 Then
               ws.Cells(i, 1).EntireRow.Delete()
           End If
       Next i
   End Function

   Public Function inArray(ByRef stringArray() As String, ByVal searchString As String) As Boolean
       Dim upperBound As Integer
       upperBound = UBound(stringArray)
       Dim i As Integer
       For i = 0 To upperBound Step 1
           If stringArray(i) = searchString Then
               inArray = True
               Exit Function
           End If
       Next
       inArray = False
   End Function

   Public Function GetUsedRange(ByRef lastRow As Integer, ByRef lastCol As Integer) As Boolean
       '
       ' GetUsedRange Macro
       ' Macro recorded 3/5/2003 by dearaan
       '
       ' Keyboard Shortcut: Ctrl+u
       '
       'Assumes that Excel's UsedRange gives at least a superset of the "real" non-null data
       ' then get the effective range of non-null data

       Dim s As String, x As Long
       Dim rng As Excel.Range
       Dim newUsedRange As Excel.Range
       Dim r1fixed As Long, c1Fixed As Long
       Dim r2Fixed As Long, c2Fixed As Long
       Dim i As Long
       Dim r1 As Long, c1 As Long
       Dim r2 As Long, c2 As Long

       'Start with Excel's faulty used range
       rng = ws.UsedRange

       'Get bounding cells for Excel's UsedRange
       'That is, Cells(r1,c1) to Cells(r2,c2)
       r1 = rng.Row
       r2 = rng.Rows.Count + r1 - 1
       c1 = rng.Column
       c2 = rng.Columns.Count + c1 - 1

       'Save existing values
       r1fixed = r1
       r2Fixed = r2
       c1Fixed = c1
       c2Fixed = c2

       'Check rows from top down for all blank rows
       'if found, shrink rows
       For i = 1 To r2Fixed - r1fixed + 1
           If oXL.WorksheetFunction.CountA(rng.Rows(i)) = 0 Then
               'empty row -- reduce
               r1 = r1 + 1
           Else
               'nonempty row, get out
               Exit For
           End If
       Next



       'Repeat for columns from left to right
       For i = 1 To c2Fixed - c1Fixed + 1
           If oXL.WorksheetFunction.CountA(rng.Columns(i)) = 0 Then
               c1 = c1 + 1
           Else
               Exit For
           End If
       Next

       'reset the range
       rng = ws.Range(ws.Cells(r1, c1), ws.Cells(r2, c2))

       'Start again
       r1fixed = r1
       c1Fixed = c1
       r2Fixed = r2
       c2Fixed = c2

       'do rows from bottom up
       For i = r2Fixed - r1fixed + 1 To 1 Step -1
           If oXL.WorksheetFunction.CountA(rng.Rows(i)) = 0 Then
               r2 = r2 - 1
           Else
               Exit For
           End If
       Next

       'repeat for columns fro right to left
       For i = c2Fixed - c1Fixed + 1 To 1 Step -1
           If oXL.WorksheetFunction.CountA(rng.Columns(i)) = 0 Then
               c2 = c2 - 1
           Else
               Exit For
           End If
       Next

       lastRow = r2
       lastCol = c2

   End Function

End Class

[edit]Please use

 tags [/vb ][/edit][/color]
Edited by Robby
Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...