Tracking Forums, Newsgroups, Maling Lists
Home Scripts Tutorials Tracker Forums
  HOME    TRACKER    Visual Basic

Code Optimization

I know there is a program that searches for crappy code. So if you have dumb code it will tell you. Or it will tell you if you have redundant un-needed code.

View Complete Forum Thread with Replies

See Related Forum Messages: Follow the Links Below to View Complete Thread
Code Optimization In VB
Can anyone provide me stuff regardiing Code Optimization


Code Optimization - Need Help Please
I have this code below that does exactly what I want except that it is VERY slow...

Its purpose is to set all of the cells to white except the row that the user has selected. Like I said, it works fine but it is eye gouging slow.. even with just a few records (less than 20). Any ideas on how I could speed it up?

Thanks for taking a look,


VB Code:
Dim A As LongDim B As LongDim C As Long With frmProjects.fgProjects    If .Row > .Rows - 1 Then Exit Sub    C = .Row    For A = 1 To .Rows - 1        .Row = A        If A = C Then            For B = 0 To .Cols - 1                .Col = B                .CellBackColor = vbYellow                DoEvents            Next B        Else            For B = 0 To .Cols - 1                .Col = B                .CellBackColor = vbWhite                DoEvents            Next B        End If    Next A    .Col = 0    .Row = C    DoEventsEnd With

Small Code Optimization - Please Help

The following code is from a larger sub. I've identified this part as the 'slow section'.

What it's doing: getting a byte from a 4bit bitmap (in array argArray_raster) then turning that byte into two separate bytes and putting the new bytes into a new array (argArray_raster_new).

Something in here is causing the sub to take approx. 1800ms to run. What is it that takes so long?

Many many thanks for any help.

- Jake

VB Code:
Dim tfInt As Long, BBTmpByte_dec As Byte, BBTmpByte_hex As Byte, BBTmpStr As Integer, tfLeftBit As String, tfRightBit As String    Dim NewByteLeft_dec As String, NewByteLeft_hex As Byte, NewByteRight_dec As String, NewByteRight_hex As Byte    Dim NewPosL As Long, NewPosR As Long, tfIncre As Long, tfZero As String    tfZero = 0    tfIncre = 70     For tfInt = BOB To lngFileLen        BBTmpByte_dec = argArray_raster(tfInt)        BBTmpByte_hex = Hex(BBTmpByte_dec)        BBTmpStr = CStr(BBTmpByte_hex)        tfLeftBit = Left(BBTmpStr, 1)        tfRightBit = Right(BBTmpStr, 1)                        tfIncre = (tfIncre + 1)        NewPosR = (tfIncre)                   tfIncre = (tfIncre + 1)        NewPosL = (tfIncre)                                 argArray_raster_new(NewPosL) = tfLeftBit        argArray_raster_new(NewPosR) = tfRightBit    Next tfInt

Code Optimization + Multiple Loops

I have a value, let's call it 'x'. I have a coloumn of data (say array 'a').

Now, 2 or more of the numbers in 'a' add up to 'x'. I need to find out which numbers do. The coloumn of data is totally random.

I am thinking:
Remove all numbers > than x. Find the next largest number after x in whats left in a. Calulcate the difference between x and a, remove all numbers in a greater than the difference - and repeat the process until a 0 difference has been found.

BUT that assumes that the biggest number after x constitutes x. It could be that many small value numbers make up x, and not some large numbers.

So, what code would I need to show all possible combinations of numbers from a that make up x?

I have been unluckily trying multiple loops for my first idea, but I really need the second idea of all combinations (because I can manually check to see if the combinations are correct).

Best Regards

VB6+SQL Server 2005: Code Or DB Optimization
is there anyway you can help me optimize this code. the slow movement of rs is so visible that it take time to display the other row.

Call opencon
Set rsbookmark = New ADODB.Recordset

If CLng(txtIDRef) > 0 Then
rsbookmark.Open "tblsuppliers", conPC, adOpenKeyset, adLockReadOnly
rsbookmark.Find "pk_supplierid =" & txtIDRef & "" 'find previous bookmark


'chk if the next record= BOF
If rsbookmark.BOF Then
MsgBox strBOF, vbInformation, strprogname
GoTo rs_skip
End If

txtrecpos = "Record " & rsbookmark.AbsolutePosition & " OF " & rsbookmark.RecordCount
Call search_SC(rsbookmark!pk_supplierid) 'SP Call where pk_supplierid is clustered index
End If

If rsbookmark.State = adStateOpen Then rsbookmark.Close
Set rsbookmark = Nothing
Call closecon

Vscroll With Additional Code Optimization Question
I did a search and read all of the threads that related to vscroll I found an example that used if then that was able to get me to my closest answer yet it did not work.

Dim f
Dim value

Private Sub Command1_Click()
a = Int(Rnd * 6) + 1
b = Int(Rnd * 6) + 1
c = Int(Rnd * 6) + 1
d = Int(Rnd * 6) + 1
e = Int(Rnd * 6) + 1
g = Int(Rnd * 6) + 1

f = a + b + c + d + e + g
Text1.Text = f

End Sub

Private Sub Command2_Click()
' Hit points
a = Int(Rnd * 6)
b = Int(Rnd * 6)
c = a + b
If a = b Then GoTo Begin

a2 = Int(Rnd * 6)
b2 = Int(Rnd * 6)
c2 = a2 + b2
If a2 = b2 Then GoTo Begin2

a3 = Int(Rnd * 6)
b3 = Int(Rnd * 6)
c3 = a3 + b3
If a3 = b3 Then GoTo Begin3

f = a + b + c + a1 + b2 + c2 + a3 + b3 + c3
Text2.Text = f
Text3.Text = f
VScroll1.value = f
VScroll1.Max = f
VScroll1.Min = 0

VScroll1.LargeChange = 1
VScroll1.SmallChange = 1

End Sub

Private Sub VScroll1_Scroll()

' problem area

VScroll1.value = f - 1
Text3.Text = f - 1
End Sub
This is my test application.

What I want it to is increment and decrement the value f in text box 3 with the vbscroll control.

Also with my hit point code I know that is not the best coding syntax for said action but it works.

What would you do to improve the code?

Thanks in advance for the help.

Source Code To Access Password Optimization,please
The code below is the complete code for revealing the Access97 password,
and the 3 first caracters of Access2000 (sorry for not putting all the
code but it repeats the filling of the array (just different values)

The question is:
Can this code be improved in any way, i mean donīt using so many controls?

if so, please be kind to explain it to me.

Option Explicit
Dim MaxSize, NextChar, MyChar, SecretPos, TempPwd
Dim Diferencia
Dim Resto1
Dim Resto2
Dim Entero
Dim I As Integer
Dim secretXx(2) As Integer
Dim Secret97(13)
Dim NoSecret2K(19)
Dim Secret2K(15, 1)

Private Sub Command1_Click()
Clipboard.SetText (Text2)
End Sub

Private Sub Command2_Click()
Clipboard.SetText ("")
Unload Me
End Sub

Private Sub Command3_Click()
End Sub

Private Sub Form_Load()
End Sub

Private Sub Inicio()
Text1 = ""
Text1 = ComDiag1.Filename
If Text1 <> "" Then
Text2 = AccessPassword(Text1)
Command1.Enabled = False
If Text2 <> "" Then
Command1.Enabled = True
End If
End If
End Sub

Private Sub Creada()
Dim fs, f, s, xx
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(Text1)
If Format(f.DateCreated, "dd/MM/yyyy") >= DTPicker1.MinDate Then
DTPicker1.Value = Format(f.DateCreated, "dd/MM/yyyy")
MsgBox "La Fecha del Archivo es Anterior al 01/01/2000", vbInformation, "Fecha InvŠlida"
End If
Diferencia = DTPicker1.Value - DTPicker2.Value
If Diferencia >= 0 Then
Resto1 = Diferencia Mod 256
Entero = Int(Resto1 / 16)
Resto2 = Resto1 Mod 16
End If
End Sub

Function AccessPassword(ByVal Filename As String) As String

secretXx(0) = 21
secretXx(1) = 59
secretXx(2) = 60

'Access 97
Secret97(0) = (&H86)
Secret97(1) = (&HFB)
Secret97(2) = (&HEC)
Secret97(3) = (&H37)
Secret97(4) = (&H5D)
Secret97(5) = (&H44)
Secret97(6) = (&H9C)
Secret97(7) = (&HFA)
Secret97(8) = (&HC6)
Secret97(9) = (&H5E)
Secret97(10) = (&H28)
Secret97(11) = (&HE6)
Secret97(12) = (&H13)
'Access 2000
NoSecret2K(0) = (&H4F)
NoSecret2K(1) = (&HEC)
NoSecret2K(2) = (&H94)
NoSecret2K(3) = (&HA)
NoSecret2K(4) = (&HA)
NoSecret2K(5) = (&HA)
NoSecret2K(6) = (&HA)
NoSecret2K(7) = (&HA)
NoSecret2K(8) = (&HA)
NoSecret2K(9) = (&HA)
NoSecret2K(10) = (&HA)
NoSecret2K(11) = (&HA)
NoSecret2K(12) = (&HA)
NoSecret2K(13) = (&HA)
NoSecret2K(14) = (&HA)
NoSecret2K(15) = (&HA)
NoSecret2K(16) = (&HA)
NoSecret2K(17) = (&HA)
NoSecret2K(18) = (&HA)
NoSecret2K(19) = (&HA)

SecretPos = 0
TempPwd = ""
Text3 = ""
Open Filename For Binary As #1
For I = 0 To 2
Seek #1, secretXx(I)
MyChar = Input(1, #1)
Text3 = Text3 & Asc(MyChar) & "="
TempPwd = TempPwd & Chr(Asc(MyChar))
Text3 = Text3 & ">"
SecretPos = 0
MyChar = ""

Label3(0).Visible = False
Label3(1).Visible = False

Label4(0).Visible = False
Label4(1).Visible = False

If TempPwd = Chr(1) & Chr(228) & Chr(195) Then
Label4(0).Visible = True
Label4(1).Visible = True
TempPwd = ""
AccessPassword = Access2K
Label3(0).Visible = True
Label3(1).Visible = True
TempPwd = ""
AccessPassword = Access97
End If
End Function

Function Access97()
'Access 97
For NextChar = 67 To 79 Step 1 ' Diez Caracteres
Seek #1, NextChar
MyChar = Input(1, #1)
TempPwd = TempPwd & Chr(Asc(MyChar) Xor Secret97(SecretPos))
Text3 = Text3 & Asc(MyChar) & " - "
SecretPos = SecretPos + 1
Next NextChar
Close #1
Access97 = TempPwd
End Function

Function Access2K()
'Access 2000
Dim HexChk As Boolean
HexChk = True
For NextChar = 67 To 105 Step 2 'Veinte Caracteres
Seek #1, NextChar
MyChar = Input(1, #1)
If HexChk Then
TempPwd = TempPwd & Chr(Asc(MyChar) Xor Const2K(SecretPos + 1)) 'Dependiente de Fecha
Text3 = Text3 & Hex(Asc(MyChar) Xor 65) & "<- "
HexChk = False
TempPwd = TempPwd & Chr(Asc(MyChar) Xor NoSecret2K(SecretPos)) 'Constante
Text3 = Text3 & Asc(MyChar) & " ->"
HexChk = True
End If
SecretPos = SecretPos + 1 'Incrementa Puntero
Next NextChar
Close #1 ' Cierra el Archivo
Access2K = TempPwd
End Function

Private Function Const2K(ByVal Posicion As Integer)
If Posicion = 1 Then
Secret2K(0, 0) = 6
Secret2K(0, 1) = 0
Secret2K(1, 0) = 7
Secret2K(1, 1) = 1
Secret2K(2, 0) = 4
Secret2K(2, 1) = 2
Secret2K(3, 0) = 5
Secret2K(3, 1) = 3
Secret2K(4, 0) = 2
Secret2K(4, 1) = 4
Secret2K(5, 0) = 3
Secret2K(5, 1) = 5
Secret2K(6, 0) = 0
Secret2K(6, 1) = 6
Secret2K(7, 0) = 1
Secret2K(7, 1) = 7
Secret2K(8, 0) = 14
Secret2K(8, 1) = 8
Secret2K(9, 0) = 15
Secret2K(9, 1) = 9
Secret2K(10, 0) = 12
Secret2K(10, 1) = 10
Secret2K(11, 0) = 13
Secret2K(11, 1) = 11
Secret2K(12, 0) = 10
Secret2K(12, 1) = 12
Secret2K(13, 0) = 11
Secret2K(13, 1) = 13
Secret2K(14, 0) = 8
Secret2K(14, 1) = 4
Secret2K(15, 0) = 9
Secret2K(15, 1) = 5
Secret2K(0, 0) = 13
Secret2K(0, 1) = 13
Secret2K(1, 0) = 12
Secret2K(1, 1) = 12
Secret2K(2, 0) = 15
Secret2K(2, 1) = 15
Secret2K(3, 0) = 14
Secret2K(3, 1) = 14
Secret2K(4, 0) = 9
Secret2K(4, 1) = 9
Secret2K(5, 0) = 8
Secret2K(5, 1) = 8
Secret2K(6, 0) = 11
Secret2K(6, 1) = 11
Secret2K(7, 0) = 10
Secret2K(7, 1) = 10
Secret2K(8, 0) = 5
Secret2K(8, 1) = 5
Secret2K(9, 0) = 4
Secret2K(9, 1) = 4
Secret2K(10, 0) = 7
Secret2K(10, 1) = 7
Secret2K(11, 0) = 6
Secret2K(11, 1) = 6
Secret2K(12, 0) = 1
Secret2K(12, 1) = 1
Secret2K(13, 0) = 0
Secret2K(13, 1) = 0
Secret2K(14, 0) = 3
Secret2K(14, 1) = 3
Secret2K(15, 0) = 2
Secret2K(15, 1) = 2
End If
Const2K = Secret2K(Resto2, 0) + Secret2K(Entero, 1) * 16
End Function

Maybe somebody may have think that i was just spamming in
my previous posts, sorry if my posts led you to jump to
conclusions but i have so little experience in posting, and
sure have post in the wrong way...


Question: Code Optimization And Table Relationship

I have two questions.. How can I optimize my code?How can I create a relation between two tables in my code?Thanks in advance!!


Option Explicit On
Module Module1
Public dir As String = Application.StartupPath & ""
Public strcon = "Provider=Microsoft.Jet.OleDb.4.0;Data Source=" & dir & "test.mdb"
End Module

Public Sub Create_DB()
Dim con As New OleDb.OleDbConnection(strcon)
Dim cat As New ADOX.Catalog
Dim tbl1 As New ADOX.Table
Dim tbl2 As New ADOX.Table
Dim tbl3 As New ADOX.Table

With tbl1
.Name = "Table_1"
.ParentCatalog = cat
Dim objKey As New ADOX.Key
objKey.Name = "PrimaryKey"
objKey.Type = ADOX.KeyTypeEnum.adKeyPrimary
With .Columns
.Append("Col1", ADOX.DataTypeEnum.adInteger)
.Append("Col2", ADOX.DataTypeEnum.adDate)
.Append("Col3", ADOX.DataTypeEnum.adVarWChar)
End With
.Columns("Col1").Properties("AutoIncrement").Value = True
objKey = Nothing
End With
With tbl2
.Name = "Table_2"
.ParentCatalog = cat
With .Columns
.Append("Col1", ADOX.DataTypeEnum.adInteger)
.Append("Col2", ADOX.DataTypeEnum.adVarWChar, 50)
End With
.Columns("Col1").Properties("AutoIncrement").Value = True
Dim objKey As New ADOX.Key
objKey.Name = "PrimaryKey"
objKey.Type = ADOX.KeyTypeEnum.adKeyPrimary
objKey = Nothing
End With
With tbl3
.Name = "Table_3"
.ParentCatalog = cat
Dim objKey As New ADOX.Key
objKey.Name = "PrimaryKey"
objKey.Type = ADOX.KeyTypeEnum.adKeyPrimary
With .Columns
.Append("Col1", ADOX.DataTypeEnum.adInteger)
.Append("Col2", ADOX.DataTypeEnum.adVarWChar, 50)
.Append("Col3", ADOX.DataTypeEnum.adVarWChar, 50)
.Append("Col4", ADOX.DataTypeEnum.adVarWChar, 50)
End With
.Columns("Col1").Properties("AutoIncrement").Value = True
objKey = Nothing
End With
With cat.Tables
End With
tbl1 = Nothing
tbl2 = Nothing
tbl3 = Nothing
cat = Nothing
End Sub

Alright, I run this subroutine many many times in my program, it basicly checks if there's a collision between an object and the map (stored in a 2d array). I was just wondering if any of you could just run over it and point out any obvious flaws. This isn't homework, so don't worry about that.

Private Function Collision(It As Thing) As Byte
Dim A As Long
Dim B As Long
'Time until collision
Dim XTime As Single
Dim YTime As Single
'If collision will happen
Dim XCol As Boolean
Dim YCol As Boolean
'Where to go if collision
Dim TargetX As Single
Dim TargetY As Single
'Store wether or not the collision happened up or down, etc.
'May be redundant to have these
Dim YCollideSide As Boolean
Dim XCollideSide As Boolean
'On Error GoTo ErrorHandle

'XDistance is (XOldSpeed + XNewSpeed)/2 (how far the thing will move)
If It.Collides = False Then Exit Function
'Loop through all blocks currently touched
For A = Int((It.X + It.XDistance) / BlockSize) To Int((It.X + It.XDistance + It.Width) / BlockSize)
For B = Int((It.Y + It.YDistance) / BlockSize) To Int((It.Y + It.YDistance + It.Height) / BlockSize)
'If the block is filled
If Map.GetMapArea(A, B) > 0 Then
'X axis collisions
'If speed*gamespeed is positive
If It.XDistance > 0 Then
'If the collision is happening. Possible, before, after
If Map.GetMapArea(A - 1, B) = 0 And Not (Map.GetBoxType(A, B) = MapInvisibleBox And Map.GetMapArea(A, B) = MapBox) _
And It.X - It.XDistance + It.Width <= A * BlockSize _
And It.X + It.XDistance + It.Width >= A * BlockSize _
And Not It.Y + It.Height = B * BlockSize _
And Not It.Y = B * BlockSize + BlockSize Then
'If the collision happened in less time than before
If (XTime = 0 Or (It.X + It.Width - A * BlockSize) / (It.XDistance) < XTime) Then
'A possible X collision
XCollideSide = False
XTime = Abs(A * BlockSize - It.X - It.Width) / (It.XDistance)
TargetX = A * BlockSize - It.Width
XCol = True
End If
End If
'If speed*gamespeed is negative
ElseIf It.XDistance < 0 Then
'If the collision is happening. Possible, before, after
If Map.GetMapArea(A + 1, B) = 0 And Not (Map.GetBoxType(A, B) = MapInvisibleBox And Map.GetMapArea(A, B) = MapBox) _
And It.X + It.XDistance <= A * BlockSize + BlockSize _
And It.X - It.XDistance >= A * BlockSize + BlockSize _
And Not It.Y + It.Height = B * BlockSize _
And Not It.Y = B * BlockSize + BlockSize Then

'If the collision happened in less time than before
If (XTime = 0 Or Abs(It.X - A * BlockSize - BlockSize) / Abs(It.XDistance) < XTime) Then
'A possible X collision
XCollideSide = True
XTime = Abs(A * BlockSize + BlockSize - It.X) / Abs(It.XDistance)
TargetX = A * BlockSize + BlockSize
XCol = True
End If
End If
End If
'Y axis collisions
'If speed*gamespeed is positive
If It.YDistance > 0 Then
'If the collision is happening. Possible, before, after
If Map.GetMapArea(A, B - 1) = 0 And Not (Map.GetBoxType(A, B) = MapInvisibleBox And Map.GetMapArea(A, B) = MapBox) _
And It.Y - It.YDistance + It.Height <= B * BlockSize _
And It.Y + It.YDistance + It.Height >= B * BlockSize _
And Not It.X + It.Width = A * BlockSize _
And Not It.X = A * BlockSize + BlockSize Then
'If the collision happened in less time than before
If YTime = 0 Or Abs((It.Y + It.Height - B * BlockSize) / (It.YDistance)) < YTime Then
'A possible X collision
YCollideSide = False
YTime = Abs(B * BlockSize - It.Y - It.Height) / (It.YDistance)
TargetY = B * BlockSize - It.Height
YCol = True
End If
End If
'If speed*gamespeed is negative
ElseIf It.YDistance < 0 Then
'If the collision is happening. Possible, before, after
If Map.GetMapArea(A, B + 1) = 0 _
And It.Y - It.YDistance >= B * BlockSize + BlockSize _
And It.Y + It.YDistance <= B * BlockSize + BlockSize _
And Not It.X + It.Width = A * BlockSize _
And Not It.X = A * BlockSize + BlockSize Then
'If the collision happened in less time than before
If (YTime = 0 Or Abs(It.Y - B * BlockSize - BlockSize) / Abs(It.YDistance) < YTime) Then
'A possible X collision
YCollideSide = True
YTime = Abs(B * BlockSize + BlockSize - It.Y) / Abs(It.YDistance)
TargetY = B * BlockSize + BlockSize
YCol = True
End If
End If
End If
End If
Next B
Next A

'If an X collisions happened and before the Y
If (XTime < YTime Or YCol = False) And XCol = True And XTime >= 0 Then
It.X = TargetX
SetXSpeed It, 0
If XCollideSide = True Then
Collision = 4
Collision = 8
End If
If Not It.YDistance = 0 Then Collision = Collision + Collision(It)
End If
'If an Y collisions happened and before the X
If (YTime <= XTime Or XCol = False) And YCol = True And YTime >= 0 Then
It.Y = TargetY
SetYSpeed It, 0
If YCollideSide = True Then
Collision = 1
Collision = 2
It.OnSomething = True
End If
If Not It.XDistance = 0 Then Collision = Collision + Collision(It)
End If
Exit Function

MsgBox "Error with collisions."
BRunning = False
End Function

I'm working on optimizing my game and I was wondering if it more efficient to...

have a public array of UDTship (contains a couple dozen variables) with public functions for ship calculations (send the ship array index and other parameters)

or to create a Ship user defined class with the ship methods and functions contained within the class.

the class might save memory b/c the variables won't be public, they can be private (correct?), yet the methods and functions of the class will be duplicated everytime a new shipclass object is instantiated (correct?).

are there any significant optimization differences?



You got to be very patient to read the entire post.

I am not getting the kind of reponse I want for my problem. Can anybody help me please?

Here is a link for a code from Myrna Larson (Check Bernie Deitrick's post) which creates combination based on a criteria. hl=en#5d7d72ba1c634a3b

I am trying to add two more criteria to the above code.

In Myrna Larson's code, if you type C in cell A1, 10 in cell A2, and add 20 numbers in the range A3:A22, it will create all possible combinations 184756 [ =COMBIN(20,10) ]

I want the same thing but I want to add two more criteria.

For better understanding download the file comb.xls from the following link:

I have listed 9 sets of 20 numbers in the range F1:Y9. I want to create all possible combinations of each set which is (184756 X 9) but list only those combinations that satisfy the two new criteria that I want to add.

Per Myrna Larson's code, I have typed C in cell A1, 10 in cell A2. Two more new criteria that I have added is, I have entered 10 in cell B1 and 2 in cell C1. This would mean that, out of (184756 X 9), list only those combinations where all 10 numbers (value specified in cell B1) in a combination matches more than or equal to 2 times (specified in cell C1) out of the 9 sets.

If you run the vba code "DoIt" from the above file, it will list only 102 combinations out of (184756 X 9). If you check any combination, you will find that all 10 numbers (satisfies the criteria in cell B1) in that combination has appeared atlest twice (satisfies the criteria in cell C1)

File is ready, issue is resolved but the problem is optimization
On my Celeron 800 MHz 256 MB SDRAM computer, It takes around 42 minutes for the entire macro to end. On a P4 with good configuration, it would take less time. I want to reduce this time and would want some of the experts like you guys to help me out.

If I only make 184756 X 9 combinations of all 9 sets without any calculation, it would only take 2 to 2 1/2 minutes but if I make some calculation (as mentioned above) before listing them, it is taking 42 minutes and I think it can be reduced.
What I think

There is something wrong in the below part. The approach I have used is a combination of macro and worksheet formulas due to which I think it is taking time but if we use arrays, it would take less time but I don't know how to use it.

'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Next i

'and save it in the buffer if it qualifies the criteria
Range(Cells(1, z), Cells(1, z + Range("A2").Value - 1)) = Split(Trim(Mid$(sValue, 3)), ", ")

If Range("AC2").Value >= Range("C1").Value Then
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Range("AC2").Value & " > " & Mid$(sValue, 3)
End If

Using the same file, if I type C in cell A1, 6 in cell A2, 4 in cell B1 and 8 in cell C1. It would list only 3 combinations out of =COMBIN(20,6) X9 (38760 X 9). It took only 8 minutes because the combinations to be processed were less. These three combinations will be such that any 4 numbers (Cell B1) out of the 6 numbers in a combination (cell A2) has appeared in 8 sets (cell C1) out of 9 sets.

In the DoIt module, change the line While recs <= 1 'Range("B2").Value to While recs <= Range("B2").Value otherwise it will just analyze the first set

I think transferring all the 9 sets into an array, then create combinations from each set in that array and do calculation within the array then then list it in the worksheet would be faster but I don't know how to do this.

More info for more ideas
I have downloaded a file LottoStatisticsXLp.xls which creates combination based on criteria. The difference between this file and my file comb.xls is that this file does not have the "Matches" criteria (cell B1 in my file) and the file LottoStatisticsXLp.xls can create combinations only upto 5 numbers. It doesn't create combinations for 10 numbers.

Here is the link for the file

Using LottoStatisticsXLp.xls file:
"Database" sheet contains the 9 sets of 20 numbers
Go to "Input" sheet, type 9 in "Start draw" (cell C30) and "Duration" (cell D30) - because we want to analyze all 9 draws.
Type 5 in "N-Tuplets" (cell E30) - We want combinations of 5 numbers.
Type 250 in "Display" (cell F30) - It can list maximum 250 combinations.
Click "N-Tuplets" button.

It will create combinations of five numbers. Check the "Output" sheet for results
You will notice that the file has created 73 (cell B7) combinations of 5 numbers listed in range D7:BX7 whose frequency is 3
It has created 1 (cell B8) combination listed in cell D8 whose frequency is 4

The processing time it takes on my computer is just 53 seconds to analyze all the 9 sets

If I do the same thing in my file comb.xls :

Type 5 in cell A2 - create combinations of 5 numbers
Type 5 in cell B1 - I want to match all 5 numbers
Type 3 in cell C1 - I want to list only combinations where the frequency is greater than or equal to 3

and run the module "DoIt", it produces the same result (my file shows a lot of duplicates that I have not yet eliminated) but it takes 193 seconds which is almost 4 times more than LottoStatisticsXLp.xls file.

This is the kind of optimization I am looking at.

Since the author of the LottoStatisticsXLp.xls file Nick Koutras has locked the project with a password, I cannot see what kind of logic he has used. I have tried contacting him lot of times but there is no response from his side.

Currently my file comb.xls is taking 42 minutes on my computer to analyze all 9 sets for combinations of 10 numbers. Can this time be reduced to 1/4th?

I hope this will help you guys understand my problem better.

This post also posted at http+//

Thanks for looking into my problem.

Dll Optimization Help
I have created a dll that works perfectly.

One of the functions ("groupduedate") within the dll is called by the following:

groupduedate(date1, allotteddays, group)

"group" can only be one of 5 options:


Is there a way I can have a combo box appear with 1-5 listed in the box similar to way the "buttons" arguments are listed in the "msgbox" command.

I hope I explained myself clearly enough

Thank you in advance

Optimization Tip
Can this piece of code be optimized?
trying to pass some RecordSet values to an arryay, removing line feed and return carriage

For i = 0 To 10
If rs_Bills.Fields(i) <> Null Or rs_Bills.Fields(i) <> vbNullString Then
ValTMP = Replace(CStr(rs_Bills.Fields(i)), Chr(13), vbNullString)
ValTMP = Replace(ValTMP, Chr(10), vbNullString)
Valores(i) = ValTMP
ValTMP = vbNullString
Valores(i) = vbNullString
End If
Next i

Really desperate about optimization...


I am running a large loop and so far I cut down a lot of the processing by optimizing little things that made a huge difference.

But I need to know some more, which between the two will take less time/memory:

VB Code:
Dim perc As Long For x = 0 To 50000  perc = Round((x / 50000) * 100)  fraProgress.Caption = "Progress - " & perc & "%"Next


VB Code:
For x = 0 To 50000  fraProgress.Caption = "Progress - " & Round((x / 50000) * 100) & "%"Next

I am thinking the first one would be the best, the second VB will create a Variant for to calculate, right ?


Anyone Up For A Little Optimization?
The following code does it's thing on a bitmap's raster data which is held in byte array argArray_raster(). This little section of code is currently taking ~3300ms to process a 800k bitmap on a 1.0GHz with 500MB.

That's way too long. Can you help me speed it up?

I was thinking that using a DC might make it faster. Is that correct?

Thanks a million for any help!

- Jake

VB Code:
Dim tfParInt        Dim tfParInt_1        Dim rByteValHex_1 As Byte        Dim rByteValHex2 As Byte        Dim tfBGColRef As Byte        Dim tfOthColRef As Byte                tfBGColRef = 0        tfOthColRef = BOB_FstByteColTblRef                For tfParInt = BOB_p1 To lngFileLen            rByteValHex_1 = argArray_raster(tfParInt)                        If rByteValHex_1 = BOB_FstByteColTblRef Then                'MsgBox ("here 1")                Put #f, tfParInt, tfBGColRef                GoTo NexttfParInt            Else                If rByteValHex_1 = 0 Then                    Put #f, tfParInt, tfOthColRef                End If            End IfNexttfParInt:        Next tfParInt

This is my first time posting here and here it goes. My boss just gave me a problem i'm having trouble figuring out. The first part is only the beggining but that's all i will ask for now and maybe i will be able to do the rest myself.

The place I work at rips lumber and we need to know the best possible yield we can get out of a board. So lets say you have an 8" wide board. I need 2", 3", 2.5", 4", 4.25" widths out of that board. Length in feet will be the next step but I will hold off on that for now. I need to use the best combination to get the most yield out of it. I can cut the board in 3 pieces max because that is the limitation of the machene. It can be less than 3 pieces if the needed peaces are 7" for example and the 5 widths needed can be less as well. So what i need is the best 3 piece or less combination out of those 5 or less pieces needed out of the 8" board that is available. I also need to know what the yeild is. I have not been programming for a couple of months only and have no idea how to approach this problem. I'm using Access 2000. If someone can answer this question for me that would be awsome. If this gets answered then i will post the next step.


What are the points that should be taken into cosideration while creating a DLL in order to optimize its level best?

File I/o Optimization
First Post...great site...lots of good info!

Using VB6, I am writing a program that opens a file (.txt), writes it to a text box. If the user presses EDIT button on the form, a new form appears allowing the user to edit the file and save it back to disk.

I have two of these text boxes that do the above.

Next to them I have another text box with a MERGE button. When the button is pushed the desire out come would be as follows:

Box1 Box2 Merge
Hi Joe Hi Joe
Good Bye Hi Bye
Good Joe
Good Bye

I have successfully coded this but my runtime for a Merge file of 10,000 takes about 5 minutes. I would like to process at least 100,000 in much less time.

I am using arrays to load the data and run the algorithm on them to spit out the Merge file. I read into an array, write a string to the text box, save string to file. Thats how I currently do it.

Is there a better way to do this? Speed is the goal as this is only part of a larger program. If I need to post any more info, please let me know what. I appreciate any and all feedback. Thanks. T

Game Optimization
I have been using VB6 for just over a year now and have decided to make a game. Direct X is a little over my head right now so I am making a 'robust' 2D shooter game with BitBlt. I have tried my game on my friend's computer and noticed that the speed was considerably slower. I was wondering how I could optimize my game? I was thinking of loading the hDC controls into memory on startup, but I don't know how much memory that would suck up. But mostly, I think the problem is all the nested loops (I use them to detect collision, for example bullets hitting an enemy ship), is there some other way to do this? Any help would be greatly appreciated!

Optimization Question
hello, I'm doing a database app for use on a single AMD k6 based system. I'm wondering if the "Favor Pentium Pro" option would be helpful, or if it would slow things down on the AMD chip. Thanks!

P.S. Message posting seems to lock up on Mozilla, seems fine on IE

Image Optimization
Someone would like me to develop an image optimization program. They were thinking of an image optimizer that would allow their hosting customers to take their images and make them smaller (be it by changing filetype to changing color depth to changing compression when possible or all of the above). What do you think something like this would take you in the way of time?

I would just want something to change file type (file convertor), compressor, and find image resizer.

Thanks in advance!

Speed Optimization
I want to optimize the speed and performance of my application. It performs several mathematical calculations, but does not compare floating point numbers to each other. I’m on the advanced optimizations dialog box and I think I shouldn’t select ‘Remove Floating Point Error Checks’ and I shouldn’t select ‘Allow Unrounded Floating Pont Operations’. Am I right?

Any help would be good.

ADO Optimization Over Network
I'm almost finished my app and I want to make sure it's going to run as fast as it can, and work properly over a network.

The db is going to be on the server and the actual app will be on each pc. What is the best way to use ADO for this?

Right now, I've been using adopenforwardonly or adopendynamic and adlockoptimistic when opening recordsets. I don't think these are the proper things to use for a network program...

Recordset Optimization.
Dear Gurus, I really need some help here. I have been cracking my head trying to optimize the following code involving large amount of records.

If rsTempObjInfo.RecordCount > 0 Then

Do Until rsTempObjInfo.EOF

lngRLSObjectID = rsTempObjInfo("RLSObjectID")
curTagID = rsTempObjInfo("TagID")
lngLogTimeOut = rsTempObjInfo("LogTimeOut")

mrsObjInfo.Filter = "RLSObjectID='" & lngRLSObjectID & "'"

If mrsObjInfo.RecordCount = 0 Then
mrsObjInfo("RLSObjectID") = lngRLSObjectID
mrsObjInfo("TagID") = curTagID
mrsObjInfo("LogTimeOut") = lngLogTimeOut
mrsObjInfo("CurrentLoc") = -1
mrsObjInfo("LastKnownLoc") = -1
mrsObjInfo("LastKnownLocTimeStart") = Now
mrsObjInfo("LastKnownLocTimeEnd") = Now
mrsObjInfo("TimeStamp") = DateAdd("n", lngLogTimeOut, Now)
mrsObjInfo("TrackState") = enuUnknownState
mrsObjInfo("MotionState") = -1
mrsObjInfo("MotionTime") = Now
mrsObjInfo("MotState") = enuMotUnknown
mrsObjInfo("MotTimeStamp") = DateAdd("s", lngLogTimeOut, Now)
mrsObjInfo("LastKnownMot") = -1
mrsObjInfo("LastKnownMotTimeStart") = Now
mrsObjInfo("LastKnownMotTimeEnd") = Now
mrsObjInfo("Updated") = 1

If mrsObjInfo("TagID") <> curTagID Then
mrsObjInfo("TagID") = curTagID
End If

If mrsObjInfo("LogTimeOut") <> lngLogTimeOut Then
mrsObjInfo("LogTimeOut") = lngLogTimeOut
End If

mrsObjInfo("Updated") = 1
End If

End If

What I'm basically trying to do here, is to update an existing recordset, mrsObjInfo using a set of recordset I just received. I want to make sure that the records in _rsTempObjInfo_ match up with _mrsObjInfo_, thus checking. With around 5000+ records, this section of code takes around 110 seconds to execute, which is too slow... I tried various method to optimize it, but failed... My database doesn't support indexing and seeking. It does support bookmark however.

I used "Filter" to search for a record instead of "Find" because from a small test I performed, "Filter" seemed to execute faster than "Find". Any ideas anyone?? Your help would be greatly appreciated.

Optimization Question
does anyone know a faster way to do this? I'm running a lot of intensive loops that take up a ton of memory here, and I'd like to minimize that if possible

vb Code:
Public Function MouseMon(ByVal nCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As LongDim iScrollUp As IntegerDim bScrolling As BooleanDim lhWnd As LongDim frmCurrent As FormDim ctrlObject As ObjectDim ctrlInternal As Object  Dim lWindowComparison As String  'Debug.Print nCode, WM_MOUSEWHEEL, wParam, lParam.mouseDataSelect Case wParam'If it's a mouse wheel messageCase WM_MOUSEWHEEL    'And the sign is negative (which means it's rotated down, toward user)    If Sgn(lParam.mouseData And &HFFFF0000) = -1 Then        'Scroll down        iScrollUp = 1    'otherwise    Else        'scroll up        iScrollUp = -1    End If        'Find the currently active form    'Iterate through each form to find the current form in the project    For Each frmCurrent In VB.Forms    'If the window was found,        'VB.Forms        On Error Resume Next        lWindowComparison = 0        lWindowComparison = GetForegroundWindow        On Error GoTo 0                If lWindowComparison = frmCurrent.hWnd Then                                 'Find the current control that the mouse is over        For Each ctrlObject In frmCurrent.Controls                        On Error Resume Next            lWindowComparison = 0            lWindowComparison = ctrlObject.hWnd            On Error GoTo 0                        Dim ltest As Long            ltest = WindowFromPoint(,                        If lWindowComparison = ltest Then                'If the control is not a scrollbar                If TypeOf ctrlObject Is VScrollBar Then                    'set the flag to scroll                    bScrolling = True                    ScrollBar ctrlObject, iScrollUp * ctrlObject.SmallChange                'otherwise                Else                                    On Error Resume Next                    lWindowComparison = 0                    lWindowComparison = ctrlObject.Tag                    On Error GoTo 0                                            'If it contains the word "scroll"                    If InStr(1, LCase(lWindowComparison), "scroll", vbTextCompare) > 0 Then                        'Search the object's container for a vscrollbar                        For Each ctrlInternal In ctrlObject.Parent                            If TypeOf ctrlInternal Is VScrollBar Then                            'If found                                'Scroll up or down                                ScrollBar ctrlInternal, iScrollUp * ctrlInternal.SmallChange                                Exit For                            End If                        Next ctrlInternal                    End If                End If            End If            'If the scroll flag is set,                'scroll the scrollbar                'exit the loop                    Next ctrlObject                                        End If                            Next frmCurrentEnd Select  MouseMon = CallNextHookEx(lngMseHook, nCode, wParam, lParam)End Function  Private Sub ScrollBar(ByRef sScrollbar As VScrollBar, ByVal iAmount As Integer)'Variable to decremenet if scrollbar difference to too largeDim iScroll As Integer'Assign initial inc/decrementiScroll = iAmount'Set to continue if an error occurs - this is the core of this sub.On Error Resume Next'Set up a loopDo    '(clear and previous errors)    err.Clear    'That increments or decrements the scrollbar    sScrollbar.Value = sScrollbar.Value + iScroll    'But if the value was too large (tried to push scrollbar past limits - raises error)    If err.Number <> 0 Then        'Then decrement the scrollbar value        iScroll = iScroll - Sgn(iAmount)    End If'Try againLoop Until err.Number = 0On Error GoTo 0End Sub

I Need Optimization/speed
This is my code, which needs to be optimized

My function geral.ReadFile:

Public Function ReadFile(FileName As String) As String
Dim Container As String, Fich As Integer

Fich = FreeFile

Open FileName For Input As #Fich
Container = Input(LOF(Fich), Fich)
Close #Fich

ReadFile = Container

End Function

In my sub:


Original = geral.ReadFile(OriginalFile)
ContainerTemp = geral.ReadFile(TempFile)

Original = Right(Original, Len(Original) - 25)
ContainerTemp = Right(ContainerTemp, Len(ContainerTemp) - 25)

If InStr(1, Original, ContainerTemp, vbBinaryCompare) >= 1 Then
Kill TempFile
Kill OriginalFile
Name TempFile As OriginalFile
ListNewRegs = ListNewRegs & OriginalFile & vbNewLine

End If

Thank you in advance for any given tip.

String Optimization
Hi all, can any one help me optimize this code. cause is make my program slow

For i = LBound(WordsArray) To UBound(WordsArray)
For j = LBound(CommaArray) To UBound(CommaArray)
If InStrB(CommaArray(j), WordsArray(i)) <> 0 Then
k = k + 1
ReDim Preserve strTemp(1 To k)
strTemp(k) = CommaArray(j)
End If
Next j
Next i

Need Better Logic And Optimization
Sorry for another thread.

I wrote this pretty quickly. But it's kind of slow even with advanced optimizations on. I avoided string concatenation by pre-buffering the string with Space$(), but it's still kind of slow even compiled with advanced optimizations on.

Any way to make it faster? Should I use byte arrays instead? A different way to generate a key of random numbers?

I'm writing a text-scramble algorithm. All it does is, generates a key that is the length of 1 to (length of text). With non-repeating numbers. This key will tell how the letters are organized, ie:

Text: abcd
Key: 4,2,1,3

With that key, the text would become: dbac

I think I need a better way of generating that key. I think that's the first thing slowing me down.

I attached my project below, it's very small cause I just started on it.

Query On Optimization
Is it true that ChrW$ is faster than Chr$ and AscW is faster than Asc?

Array Optimization
Hello, everyone.

First, I must ask for lenience on your part because the attached code was actually written and executed in Excel VBA (though there was no need to), but I'm posting it here because there is actually no Excel VBA specific code. I just used VBA because I later want to view my data on a spreadsheet and it's much more convenient to do that in VBA.

Here's what I'm doing right now.

1. I read a rather large text file (which is in a slightly customized Western European encoding) into a byte array byte by byte (to convert it to MS-DOS readable encoding later on).

2. I pass each byte through a rather long SELECT CASE statement (20 nodes) enveloped in a FOR...NEXT loop and change each byte value into a value that falls below 125 (if necessary)

Here's my problem. The byte array is slightly large, actually having nearly one million elements, and the code slows down exponentially once it passes the 200,000th element. I tried leaving it on for the night, had about six hours of sleep, checked the next morning, and it was still chugging along. What's really infuriating is that the first 100,000 elements are processed in something less than 10 seconds.

I tried several things.

1. dictionary collection: It's slow. But not as slow as a byte array. It still does consume about 30 minutes.

2. splitting the byte array into a two dimensional array: Something like MyArray(10, 100000). The same problem arises here. Slows down after 200,000.

3. Looking around for a encoding translation module: Still looking around while working on one at the moment (so any comments on this would be helpful as well).

Would this slowdown be a result of using VBA (which I doubt) or some internal VB glitch that has trouble handling arrays larger than 200000 elements? If so, is there a workaround?

Have a nice day! (cause I certainly won't)

Memory And Optimization...
I've searched the forums high and low about the different approaches on optimization, memory management, and speed, but whenever I find something interesting, either the next poster or a simple test proves it wrong, so I have a couple of questions, mostly basics, that I'd really like to know:

1-Why is boolean 16-bit? Isn't it supposed to hold 1 bit of data, either 1 or 0? Why not switch all booleans with bytes then?

2-Is there any difference in the performance of IF-blocks and SelectCase-blocks?

3-Could someone please explain in-depth what the 'Advanced Optimizations' do? Ok, I understand that "Remove Array Bound Checks" removes arrays boundaries, but what does aliasing mean? It isn't visual aliasing, is it? Or what are "FDIV" checks?

4-From my tests, it seems that each time an array(I tested mostly with UDT arrays) is redimensioned with only one element(0), some parts of it are left in memory, which clogs it quite a lot over time. Is there a way around this?

5-In binary reading mode, skipping data with Seek doesn't seem to give different performance from Getting the data. Is that correct?

6-Using a benchmarking module by one of the forum members(sorry, can't remember the UN), I found that simple mathematical operations on integerslongs are performed faster than on bytes. Is the module flawed, or is it supposed to happen?

7-Getting the data by small chunks seem to be around 10x slower than reading it once. Why would that happen?

Thanx in advance!

Optimization Question
Looking to optimize an application.

The part I am concerned with is MS SQL 2000 inserts and selects. The application is run a stand alone system and in a Citrix Farm. I can't guarantee the load on the Citrix servers, so instead of keeping the data in memory, we went with temporary DB storage.

I have one insert statement and one select statement. This process is run twice daily for 720 plans, and each plan can insert 60k records into a table.

I am considering changing the Inserts and Selects into Stored Procedures. Just looking for someone to bounce this off of.

Once I am done processing the one plan, I truncate the table, if no other plan is found in the table. If other plans are found, I check to see if they are older then two days, and if so, Truncate the table, if they are new records, someone else is running the process, so I delete the records for the plan I am working on. I truncate to reduce DB resources. This part is fine, just giving some back ground.

The problem I am facing:

I pull data from a different database (BTreave and no normalization). I then have to filter the data in VB, large loop. The records that pass the filter are then inserted into MSSQL 2000 with ADO and an insert statement, such as:

INSERT INTO TABLEA([Plan], [FieldA], [FieldB], [FieldC], [FieldD], [FieldE], [FieldF], [FieldG], [InsertDate])VALUES('XYZ','0110110','1','0100101','STRINGHERE','111','11111111','2','12/31/2003')

The table takes strings. Long story, but trust me, thats what I was forced to do.

I have been advised that BULK INSERT is not an option, by the DBA. He has the permission locked down and prefers to keep it to himself. Greedy DBAs.

The fields in the insert statement are unique for every insert statement. This INSERT statement might run 60k times for one plan, and the next plan it might run 2 times. Would I see any speed improvement by running this as a stored procedure?

Is there a way that I can send all these records at one time? Would prefer to reduce the amount of network transmissions to the server.

Now, after all the records are stored nicely in the database, I run a select statement on them to return a small record set, many.. many... many times.

SELECT [FieldA], [FieldB], [FieldE], [FieldF] FROM [TABLEA] WHERE [Plan] = 'XYZ' AND ([FieldA] = '5150830' OR FieldE= '5150830') OR ([FieldA] LIKE '%5150830%' OR FieldE LIKE '%5150830%')

Yes, thats ugly, and I had no choice, trust me on this.

Will there be a speed improvement by putting this into a stored procedure?

I am thinking that having a stored procedure will remove the processing needed to repeat parsing, optimizing and compiling with each execution of these statements.

Will the cache of the server benefit this process?

How can I bulk insert if the DBA will not give the application user the proper permissions?

Just looking for some options and suggestions. Thanks!

Needs Optimization - Too Slow!
I have the following code that I need optimized. I have gotten the rest of the application running pretty fast, however I am not sure how to get this faster.

A little insight - in the code below the variable blData is a string that holds, on average, 5mb. It is simply a text file that has been read to a string. I am searching for a string within the file. If found then I am removing from the start of the string to the next vbCrLf.

I am open to all suggestions - if there is any way to make this run faster I would like to hear it.

VB Code:
Friend Sub CheckFile(FilePath As String, Optional isFolder As Boolean = False)        Dim xPos As Long    Dim xPos2 As Long    Dim oEntry As String    Dim sEntry() As String    Dim f As mFileApi.FileInfo    Dim tp As String    Dim fStat As String    Dim fType As String    Dim fSize As String    Dim fCreated As String    Dim fMod As String    Dim fAccessed As String    Dim fClr As Long    On Error GoTo ERROR_OCCURRED     If wasCancelled Then Exit Sub     fStat = ""     If isFolder Then        'Folder - don't bother w/properties        fType = "Folder"        fSize = ""        fCreated = ""        fMod = ""        fAccessed = ""    Else        'File - get properties        f = mFileApi.GetFileInfo(FilePath)        fType = "File"        fSize = f.fSize        fCreated = f.fCreated        fMod = f.fModified        fAccessed = f.fAccessed    End If     'Check to see if the FilePath was found in orig file    xPos = InStr(1, blData, FilePath, vbTextCompare)     If xPos <> 0 Then        'Item Found - compare props        'xPos        xPos2 = InStr(xPos, blData, vbCrLf, vbBinaryCompare)                If xPos2 = 0 Then            'End char not found - grab to end of file            oEntry = Right(blData, Len(blData) - xPos)            blData = Left(blData, xPos)        Else            'Remove the string from orig file            oEntry = Mid(blData, xPos, xPos2 - xPos)            blData = Left(blData, xPos - 1) & Right(blData, Len(blData) - xPos2 - 1)        End If                 sEntry = Split(oEntry, ",")                'Check to see if the file has changed        If Trim(fSize) <> Trim(sEntry(3)) Or _            Trim(fCreated) <> Trim(sEntry(4)) Or _            Trim(fMod) <> Trim(sEntry(5)) Then                        fStat = "Changed"            fClr = CLR_CHANGED        Else            'File has not changed - add it to the unchanged list            If Len(blUnchanged) > 0 Then                blUnchanged = blUnchanged & vbCrLf            End If                        If Right(oEntry, Len(vbCrLf)) = vbCrLf Then                oEntry = Left(oEntry, Len(oEntry) - Len(vbCrLf))            End If                        blUnchanged = blUnchanged & oEntry        End If    Else        'Not found in orig file - new        fStat = "New"        fClr = CLR_NEW    End If         If fStat <> "" Then        InsertRow FilePath, fStat, fType, fSize, fCreated, fMod, fAccessed, fClr    End If        Exit Sub    ERROR_OCCURRED:     If Err.Number = 70 Then Resume Next        LogError "CheckFile2"End Sub

Function Optimization
Hi all!
I wrote the following function:

Function FillBitmap(Buffer() As Byte, SrcColor As RGB, DestColor As RGB, Width As Long, Height As Long)
Dim Red As Double, Green As Double, Blue As Double
Dim DeltaRed As Double, DeltaBlue As Double, DeltaGreen As Double
SrcColorRed = SrcColor.Red
SrcColorGreen = SrcColor.Green
SrcColorBlue = SrcColor.Blue
DestColorRed = DestColor.Red
DestColorGreen = DestColor.Green
DestColorBlue = DestColor.Blue
DeltaRed = (SrcColorRed - DestColorRed) / Height
DeltaGreen = (SrcColorGreen - DestColorGreen) / Height
DeltaBlue = (SrcColorBlue - DestColorBlue) / Height
Red = SrcColor.Red
Green = SrcColor.Green
Blue = SrcColor.Blue
For Y = 0 To Height - 1
Red = Red - DeltaRed
Green = Green - DeltaGreen
Blue = Blue - DeltaBlue
For X = 0 To Width - 1
Buffer((Y * Width + X) * 3) = Blue
Buffer((Y * Width + X) * 3 + 1) = Green
Buffer((Y * Width + X) * 3 + 2) = Red
Next X
Next Y
End Function

But it's really slow! It takes about a second (950 ms) to fill fullscreen 800x600. How can I optimize it for better performance?

Two Optimization Questions
I wanted to get some expert opinions here on things that will help make my application less taxing on the CPU of the user. I have two areas that I am in need of help in.

First, each of my forms has a background image. What is the best way to use a bg image? Is it to just set the background property of the form to the image at design time? Is it to just put an image or picture box on the screen and load an image in there at design time? Is there a faster way to do it using an image or picture or just the form background if you load in at run time?

Second, with regards to forms is it better to load them all in and just use show/hide when navigating between them and unload them all when you exit the program or is it better to unload a form every time you are done with it and reload it then when you are going back to it?

Thanks guys, I appreciate any insight and help you can give me.

Optimization Utility
Hello Everyone,
I once came across a utility for VC++ (3rd Party) which used to scan the code and used to optimize it wherever necesarry. Is there any thing similar utility for VB?

Program Optimization
just a few days ago i was reading an online article on optimizing vb programs to be smaller, run faster, and not use up as much memory. one of the things mentioned in the article was that modules load on running the program, but classes you can load and unload whenever you want to reduce memory usage. now by classes, im guessing this guy meant class modules, though i could be wrong, and when i tried loading and unloading them, i couldnt because they arent objects. can anyone clear up what this guy was trying to say and how i could do it?
thanks in advance.

BTW, does anyone know where i can get some progress bars for vb6? the one if got now is kinda dodgy looking and doesnt fit in with my program's look, thanks again.

Image Optimization
hi friends,

can we optimize the image size without loosing much resolution of the image. i mean i want to decrease the image size(file size).


Optimization Techniques
Hi everyone,

I'm currently working as a Developer for a firm who do alot of Soft Systems Modeling. They use a program Called MooD which has an ActiveX API - so my job is to write tools that interface with the models via the API and do tasks - such as mapping of multiple ICs onto processes - blah blah blah.

Now thats the background out of the way i would like to know if any one has any great or good optimzation tips, because the API is a bottleneck (as far as i can see - ive ran my program through vbWatch ) and i would like to speed up my code as much as possible!

Each thing in the model has its own unique GUID, i have functions is classes such as MoodConnecter.GetAllObjects() this will return an Array of all the object IDs - I'm wondering would it be better to use a collection? Are they suitably faster as you dont need to size them first - you just fill them up? Are they faster to itterate?

Are there any major do's and don'ts for gaining speed? My program is quite large (about 6000 lines of code, 15 Classes - 10 Forms (most are MDI Children)) - I've done as much as i can as far as i can tell?

So yes generally any help would be great

PS. An another note - is there anyway to sort an Image Combo? The API does not allow for sorting - so its left to the controls to achieve this!

I&#039;m At The End Of My Optimization Rope
Well, my app takes too long to load. It's a commercial app, so I was hoping to make it as fast as possible, but it takes an annoying 11 sec on my P3/450 mhz/128 MB Machine -- and is depressingly slower on average machines. Woe is me. This is the first app I ever wrote, and everything works great except for this one problem.

Sure, I've got a splash screen with a progress bar, but the problem is that it takes many seconds for my main form to even get to the Form_Load event(after calling Load Form). The splash screen just sits there for a while before the progress bar starts to actually move.

The main form is control-rich (many textboxes & datagrids on SStabs) so I guess it's taking a long time to load it all into memory. Total size of .exe is 344KB. I cannot remove any controls from the form, as product launch is ASAP and there's no time to redo the user interface.

I've tried:
1. Trying both P-Code and native code compiling
2. Trying to optimize for size vs speed
3. Using a compression program to reduce the size of my .exe even further
4. Converting all ADODC's to simple ADO recordsets
5. Loading ALL graphic resources at runtime only
6. Removing all other forms from the project
7. I even went so far as to replace all standard buttons and textboxes with windowless versions to reduce resource usage.

Result: NO improvement, not even 1 or 2 seconds faster!!!

Before I call it quits, I thought I'd ask you guys for any suggestions, in case there's something I missed. Thanks for reading this long post.

Performance Optimization
Well this is the senerio..
I have three applications working together.
1) prints pdf files
2) FTP transfer of files from one server to this server
3) monitors if ADOBE is running (ie while printing process is going on sometimes Adobe displays a modal dialog if file is bad)In that case this application kills adobe
All the applications are to run unattended and in endless loops
The printing app consumes 99% CPU and for some reason and it terminates once in one - two days
Please guide what would be a good way to handle the situation
Is there a way to optimize the performance?
Or if we could check that cpu usage is maximum then put rest of the applications to DoEvents.

MSChart Optimization
I've got a piece of code that reads in a .csv file and charts it accordingly using msChart. However, I find the time taken to chart the data extremely slow. Is it always like that? The snippet of code is given below

Set tempfile = fso2.OpenTextFile(Drive1.Drive & "Holterdata.csv", ForReading)
ReDim values(1 To 2048, 1 To 2)
For X = 1 To 2048
On Error GoTo CHART
values(X, 1) = tempfile.ReadLine
Next X

CHART: Chart1.chartType = VtChChartType2dLine
Chart1.RowCount = 2
Chart1.ColumnCount = 2048
Chart1.ChartData = values

I'm a noobie to msChart, could someone help me speed up this process.

Optimization : Any Idea?
Hi guys

My vb project consist of this : i have a workbook, like excel, with sheets, an average of maybe 30 sheets per customer. Ok, what i have to do (and it's functionnal by the way), is to save the entire data that is in there. This mean, 11 columns, 52 rows, for a total of 572 number each page, so that number can reach 16K and more for the workbook... it's big. My problem is here : it takes too much time to save. One of my customer have 42 products (42 sheets) and it took 55 minutes last night to save data Considering that we have about 30 customer well... you do the math.

I'm using VB6 with SQL Server 7. What I actually do is, for each number, I first) check if the main key exists in the database (consisting of about 10 columns...) second) if exists, update else insert. Each number represent a record in the database.

What can I do so that my program take less time to save all thoses data??!?

btw, i'm not the one who create the database, neither the table that have 10 STRING keys I've just been told to save data in that table....

thanks a lot lot lot loooot in advance my friends, if you have any idea, tips, whatever, that could improve my saving time...

According to my calculations the problem doesn't exist.

Array Optimization
Hello, everyone.

First, I must ask for lenience on your part because the attached code was actually written and executed in Excel VBA (though there was no need to), but I'm posting it here because there is actually no Excel VBA specific code. I just used VBA because I later want to view my data on a spreadsheet and it's much more convenient to do that in VBA.

Here's what I'm doing right now.

1. I read a rather large text file (which is in a slightly customized Western European encoding) into a byte array byte by byte (to convert it to MS-DOS readable encoding later on).

2. I pass each byte through a rather long SELECT CASE statement (20 nodes) enveloped in a FOR...NEXT loop and change each byte value into a value that falls below 125 (if necessary)

Here's my problem. The byte array is slightly large, actually having nearly one million elements, and the code slows down exponentially once it passes the 200,000th element. I tried leaving it on for the night, had about six hours of sleep, checked the next morning, and it was still chugging along. What's really infuriating is that the first 100,000 elements are processed in something less than 10 seconds.

I tried several things.

1. dictionary collection: It's slow. But not as slow as a byte array. It still does consume about 30 minutes.

2. splitting the byte array into a two dimensional array: Something like MyArray(10, 100000). The same problem arises here. Slows down after 200,000.

3. Looking around for a encoding translation module: Still looking around while working on one at the moment (so any comments on this would be helpful as well).

Would this slowdown be a result of using VBA (which I doubt) or some internal VB glitch that has trouble handling arrays larger than 200000 elements? If so, is there a workaround?

Have a nice day! (cause I certainly won't)

Need Optimization (work Between 2 Sheets)
this is my first attempt to write VBA in Excel.
after some short research I managed to get what I want
(tis very simple), however I am certain that my code
is somehow not the-best-thing-to-do and I could
use some advice on how to do it better so as to improve my skills on it.
any help or advice would be appreciated.
thanxs in return.

prov description.
sheet1: button1: on press, I connect (using ADO) to an MSSQL Server
and retrieve some item's data. results in 2 columns (itemcode, description)

Sub Button1_click()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection

cn.ConnectionString = "Provider=SQLOLEDB.1;" _
& "Persist Security Info=False;" _
& "Password=****;" _
& "User ID=sa;" _
& "Initial Catalog=***;" _
& "Data Source=r***"


Dim rs As New ADODB.Recordset
rs.CursorLocation = adUseClient

Dim sql As String

rs.Open sql, cn, adOpenKeyset, adLockOptimistic, adCmdText

If rs.RecordCount > 0 Then


Dim aCol, bCol As String
Dim c As Long
c = 1

Do Until rs.EOF
aCol = "A" & c
bCol = "B" & c

ActiveCell.Value = "" & rs.Fields("CODE")

ActiveCell.Value = "" & rs.Fields("DESCRIPTION")

c = c + 1

End If

Set rs = Nothing

Set cn = Nothing

End Sub

in the first collumn (column A) we write some itemcodes.
there is a Button (button2). on click we search these codes
in sheet1 and get their description and write it in the cell next to them
in (sheet2:columnB)

Sub button2_click()
Dim xlsheet1 As Excel.Worksheet
Dim xlsheet2 As Excel.Worksheet
Dim strID As String

Set xlsheet1 = Sheets("sheet2") 'search
Set xlsheet2 = Sheets("sheet1") 'lookup

Dim getValue As String

Dim i As Long
i = 1
Do While IsEmpty(ActiveCell) = False
getValue = ActiveCell.Value

Dim c As Long
c = 1
Dim res As String
res = ""
Do While IsEmpty(ActiveCell) = False
strID = ActiveCell.Value
If strID = getValue Then

res = "B" & c
res = Range(res).Value
Exit Do
End If

ActiveCell.Offset(1, 0).Select
c = c + 1

Dim curr As String
curr = "B" & i
ActiveCell.Value = res

i = i + 1
Dim nex As String
nex = "A" & i

End sub

thanxs again

String Function Optimization
Hello there, I'm writing a program that is preforming anywhere from hundreds to nearly half a million string functions in one action. I'm doing my best to optimize the usage of string functions, but I need some help.

I've tried very hard to minimize the use of InStr(), because compared to other string functions its a little heavy. I found that I could perform the same action I'm trying to achieve with the use of Split(). I was wondering how these two functions compare, speed-wise?

Does anyone know of a website or page that shows all the string functions in comparison to each other?

Thank you,

VB6, EXCEL, Array Optimization
I have been investigating about a way to optimize my interaction with excel via VB6, I have been reading that they use some king of an array to make the writhing later in Excel directly,

Is this TRUEÖ..?

And if itís so this is what I have been trying to do in that matter, or maybe Iím completely wrong, but I havenít been able to try this solution, because in the omitted line it keeps telling me that Itís out of rangeÖ

But the other thing that I donít understand is how Iím supposed to write the info in my array to excel

Dim MyArray() As Variant
Dim Rng As Range
Dim NumRows As Long
Dim NumCols As Long

NumRows = conteo_celdas
NumCols = 1
C = NumCols

ReDim MyArray(1 To NumRows, 1 To 1)
For R = 1 To NumRows
MyArray(R, C) = "=VLOOKUP(C:C,'" & App.Path & "pool[new2.xls]HLMX'!$F:$F,1,0)"
Debug.Print R; MyArray(R, C).Value
Next R

Set Rng = MyXLApp.Range("D2").Resize(NumRows, NumCols)
Rng.Value = MyArray()
Debug.Print Rng.Value

File To Binary Optimization
I got this code but the problem is that it goes slow, end even slower after it hit 7000, Help me out guys and tell me how to make it faster. it read a file and return it binary

Dim l3n
l3n = FileLen(txtPath.Text)

' ** NOTE: ENTER YOUR FILE NAME HERE **color=green>
strFileName = txtPath.Text

' Get a free handle to use to connect to afile
hFile = FreeFile

' Open the file in binary mode so we can read in the bytes
Open strFileName For Binary As #hFile

' Make the buffer big enough to read all the fileand read it
ReDim bytData(1 To LOF(hFile))
TxtMake = bytData
Get hFile, , bytData
Close hFile

' Build a string from the byte array so we candisplay it
strDisplay = StrConv(bytData, vbUnicode)
TxtMake = strDisplay

' Now convert the first three chars to bit representations
' (This is to demonstrate how to get the bits out)

' First set up the bit vals array
Dim i As Integer
lngBitVal(0) = 1
For i = 1 To 10000
lngBitVal(i) = lngBitVal(i) * 2
Next i

' Now build a display of the first three chars from the file
strDisplay = ""
For lngIndex = 1 To l3n
'TxtMake = CBool(bytData(lngIndex) And lngBitVal(lngBit))

' Perform a bitwise calculation on the current byte
' and build a binary string representation
For lngBit = 0 To 0 Step -1
On Error GoTo ntg
txtZiped.Text = txtZiped.Text & Abs(CBool(bytData(lngIndex) And lngBitVal(lngBit)))

Label1.Caption = lngIndex & " out of " & l3n
Next lngBit
strDisplay = strDisplay
Next lngIndex

' Display the results
strDisplay = _
Open "C:frunlog.txt" For Output As #1
Print #1, txtZiped
Close #1

Access Table Optimization In VB
I'm writing and deleting 600 entries in AccessDB table per minute. It seems that DB size is increasing, no matter that when I write 600 new entries I also delete 600 old ones. Can you tell me how to optimize the table in database in VBA. Optimize and repair database is not an option, since it must be done within Access.

Copyright © 2005-08, All rights reserved