Modify a Excel Variant Array with a PBWin 7.02 dll

[John Hackl]

'Demonstration of modifying excel data with a pb dll using a
'variant no paren array
'Useful up to 100k cells, larger than that is very slow
'Requires pbwin7.02
#COMPILE DLL "ModvArry.dll"
#DIM ALL
FUNCTION ModvArray ALIAS "ModvArray" (vArrayNoParen AS VARIANT,vDllStartTime AS VARIANT) EXPORT AS STRING

   DIM dDllStartTime AS DOUBLE
   LET dDllStartTime = VARIANT#(vDllStartTime)

   DIM sReturnInfo AS STRING
   sReturnInfo = " dll crankup time " &  FORMAT$(TIMER - dDllStartTime,"000.00") & $CRLF

   IF VARIANTVT(vArrayNoParen) = 0 OR VARIANTVT(vArrayNoParen) = 1 THEN
      MSGBOX "nothing in vInArray"
      FUNCTION = "Error"
      EXIT FUNCTION
   END IF

   DIM i AS LONG
   DIM j AS LONG
   DIM vArray2Dim(0) AS VARIANT
   LET vArray2Dim() = vArrayNoParen
   DIM ubrows AS LONG
   DIM ubcols AS LONG

   ubrows = UBOUND(vArray2Dim(),1)
   ubcols = UBOUND(vArray2Dim(),2)
   IF ubrows = 0 OR ubcols = 0 OR ubrows = -1 OR ubcols = -1 THEN
       MSGBOX "InArray has no dimensions"
       FUNCTION = "Error"
       EXIT FUNCTION
   END IF
   sReturnInfo =  sReturnInfo & " dll up to mod array " &  FORMAT$(TIMER - dDllStartTime,"000.00") & $CRLF

   DIM vtype AS LONG
   FOR j = 1 TO ubcols
      FOR i = 1 TO ubrows
         vtype = VARIANTVT(vArray2Dim(i,j))
         IF vtype = 0  OR  vtype = 1 THEN ' nothing or null
            vArray2Dim(i,j) = "was a blank" & STR$(i) & STR$(j)
         ELSEIF vtype = 8 THEN 'string
            vArray2Dim(i,j) = "string " & VARIANT$(vArray2Dim(i, j))
         ELSEIF vtype => 2 AND vtype <= 6 THEN
            vArray2Dim(i,j) = VARIANT#(vArray2Dim(i, j)) + 100
         END IF
       NEXT i
   NEXT j
   sReturnInfo =  sReturnInfo & " dll past mod array " &  FORMAT$(TIMER - dDllStartTime,"000.00") & $CRLF

   LET vArrayNoParen = vArray2Dim()
   sReturnInfo =  sReturnInfo & " dll past assign " &  FORMAT$(TIMER - dDllStartTime,"000.00")

   FUNCTION = sReturnInfo
END FUNCTION


'ModvArry.xls
Attribute VB_Name = "Module1"
Declare Function ModvArray Lib "ModvArry.dll" (vArrayNoParen As Variant, vDllStartTime As Variant) As String
Option Explicit

Sub StartTest()
  
  Dim Stime As Variant
  Stime = Timer
  Call Test
  Debug.Print "after function return " & Timer - Stime
  End
   
End Sub

Function Test()
  Dim Stime As Variant
  Stime = Timer
  
  Dim vArrayNoParen As Variant
  
  Dim lRows As Variant
  Dim lCols As Variant
  Dim oRange As Range
  Dim ubrows As Variant
  Dim ubcols As Variant
  Dim SheetName As Variant
  Dim vDllStartTime As Variant
  Dim vPutInCellsStartTime As Variant
  Dim SReturnValue As String

  'much larger than 100k cells and it slows down tremendously
  lRows = 30000
  lCols = 3
  SheetName = "Sheet1"
  
  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path
  
  ThisWorkbook.Worksheets(SheetName).Activate
  Range(Cells(1, 1), Cells.SpecialCells(xlLastCell)).Delete
  Range(Cells(1, 1), Cells(lRows, 1)).Formula = "=TEXT(ROW(),""000"")"
  Range(Cells(1, 2), Cells(lRows, 2)).Formula = "=row()"
  Range(Cells(1, 3), Cells(lRows, 3)).Value = "something"
  Cells(4, 1).Value = Empty
  
  Debug.Print "Start to before assigning cells " & Timer - Stime
  'by far the fastest way to get cell data is a no paren variant
  vArrayNoParen = Range(Cells(1, 1), Cells(lRows, lCols)).Value
  Debug.Print "after assign cells " & Timer - Stime
  
  vDllStartTime = Timer
  SReturnValue = ModvArray(vArrayNoParen, vDllStartTime)
  Debug.Print SReturnValue
  Debug.Print " time within dll " & Timer - vDllStartTime
  Debug.Print "start to after dll " & Timer - Stime
  
  If SReturnValue = "Error" Then
     MsgBox "dll returned error"
  Else
     vPutInCellsStartTime = Timer
     ubrows = UBound(vArrayNoParen, 1)
     ubcols = UBound(vArrayNoParen, 2)
     Set oRange = Cells(1, 5)
     'oRange.Resize(ubRows, ubCols).NumberFormat = "@" 'to force text format
     oRange.Resize(ubrows, ubcols).Value = vArrayNoParen
     Debug.Print " time to put in cells " & Timer - vPutInCellsStartTime
  End If
  Set oRange = Nothing
  Debug.Print "done within function " & Timer - Stime

End Function
'30000 rows, 3 columns
'Start to before assigning cells 0.8808594
'after assign cells 1.041016
' dll crankup time -000.00
' dll up to mod array 000.05
' dll past mod array 000.22
' dll past assign 000.71
' time within dll 1.148438
'start to after dll 2.189453
' time to put in cells 2.910156
'done within function 5.099609
'after function return 6.089844

[This message has been edited by John Hackl (edited June 13, 2003).]