Minglism
07-15-2008, 04:03 PM
I don't know why my program gets slower and slower after running for several minutes. At the very beginning it can process 3 to 4 htm files per sec. And it slows down to several seconds per htm files as it runs. I tried to step in the code and found that it was the loop, showing in red, that slows down the whole program. Can anybody explain why it happens and solve the problem as well? Thanks!
Here is the code:
Dim i As Long, j As Long, RowNo As Long, peakNO As Integer
Dim peplen As Integer, m As Integer, iLoading As Integer, jLoading As Integer
Dim sPath As String, sTxt As String, hits As String
Dim GenInfo(1 To 11) As Variant, PeakInfo() As Variant
Sub extract_info()
ThisWorkbook.Sheets(1).Activate
Application.ScreenUpdating = False
i = 0
RowNo = [l1048576].End(xlUp).Row + 1
If RowNo <> 2 Then
RowNo = RowNo + 1
End If
Set r = Cells(RowNo, 1)
sPath = ThisWorkbook.Path & "\" & "htms\"
sTxt = Dir(sPath & "*.htm")
Do While sTxt <> ""
ThisWorkbook.Sheets(2).Activate
With ActiveSheet.QueryTables.Add(Connection:="finder;file:///" & sPath & sTxt _
, Destination:=Range("$A$1"))
.Name = sTxt
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'---------------------------------------------- Looking for peptide sequence --------------------------------------
GenInfo(1) = Mid(ThisWorkbook.Sheets(2).Cells(5, 1), 24)
peplen = Len(GenInfo(1))
'---------------------------------------------- Looking for protein name --------------------------------------
GenInfo(2) = Mid(ThisWorkbook.Sheets(2).Cells(6, 1), 10, Application.Find(",", ThisWorkbook.Sheets(2).Cells(6, 1)) - 10)
'---------------------------------------------- Looking for precursor mass --------------------------------------
GenInfo(3) = Mid(ThisWorkbook.Sheets(2).Cells(8, 1), Application.Find("(", ThisWorkbook.Sheets(2).Cells(8, 1)) + 1, _
Application.Find(",", ThisWorkbook.Sheets(2).Cells(8, 1)) - Application.Find("(", ThisWorkbook.Sheets(2).Cells(8, 1)) - 1)
'---------------------------------------------- Looking for charge state --------------------------------------
GenInfo(4) = Mid(ThisWorkbook.Sheets(2).Cells(8, 1), Application.Find(",", ThisWorkbook.Sheets(2).Cells(8, 1)) + 1, 2)
'---------------------------------------------- Looking for query number --------------------------------------
GenInfo(5) = Mid(ThisWorkbook.Sheets(2).Cells(8, 1), Application.Find("y", ThisWorkbook.Sheets(2).Cells(8, 1)) + 2, _
Application.Find(":", ThisWorkbook.Sheets(2).Cells(8, 1)) - Application.Find("y", ThisWorkbook.Sheets(2).Cells(8, 1)) - 2)
'---------------------------------------------- Looking for file name --------------------------------------
GenInfo(6) = Mid(ThisWorkbook.Sheets(2).Cells(9, 1), 10)
'---------------------------------------------- Looking for theoretical mass --------------------------------------
If ThisWorkbook.Sheets(2).Cells(14, 2) <> "" Then
GenInfo(7) = ThisWorkbook.Sheets(2).Cells(14, 2)
Else
GenInfo(7) = Mid(ThisWorkbook.Sheets(2).Cells(14, 1), 48)
End If
'---------------------------------------------- Looking for Hit --------------------------------------
GenInfo(8) = Mid(sTxt, Application.Find("hit=", sTxt) + 4, 1)
'********************************************** Loading other infomations **************************************
iLoading = 15
'---------------------------------------------- Looking for fixed modifications --------------------------------------
If Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 1, 5) = "Fixed" Then
GenInfo(9) = Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 22)
iLoading = iLoading + 1
Else
GenInfo(9) = ""
End If
'---------------------------------------------- Looking for Variable modifications --------------------------------------
If Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 1, 8) = "Variable" Then
Do While Mid(ThisWorkbook.Sheets(2).Cells(iLoading + 1, 1), 1, 10) <> "Ions Score" _
And Mid(ThisWorkbook.Sheets(2).Cells(iLoading + 1, 1), 1, 9) <> "Component"
GenInfo(10) = ThisWorkbook.Sheets(2).Cells(iLoading + 1, 1) + " & " + GenInfo(10)
iLoading = iLoading + 1
Loop
iLoading = iLoading + 1
Else
GenInfo(10) = ""
End If
If Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 1, 9) = "Component" Then
iLoading = iLoading + 1
End If
'---------------------------------------------- Looking for ions score ---------------------------------------------------
If Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 1, 10) = "Ions Score" Then
GenInfo(11) = Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 13, 3)
peakNO = Mid(ThisWorkbook.Sheets(2).Cells(iLoading + 1, 1), 21, Application.Find("/", ThisWorkbook.Sheets(2).Cells(iLoading + 1, 1)) - 21)
iLoading = iLoading + 3
End If
ThisWorkbook.Sheets(1).Activate
RowNo = [l1048576].End(xlUp).Row + 1
If RowNo <> 2 Then
RowNo = RowNo + 1
End If
Range(Cells(RowNo, 1), Cells(RowNo, 11)).Value = GenInfo
'************************************************* Import matched peaks ********************************************************
ReDim PeakInfo(1 To 2, 1 To peakNO)
i = 1
If ThisWorkbook.Sheets(2).Cells(iLoading, 1) = "#" Then
For m = 2 To ThisWorkbook.Sheets(2).Cells(iLoading, 130).End(xlToLeft).Column
If ThisWorkbook.Sheets(2).Cells(iLoading, m) = "a" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "Immon." Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b++" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y++" Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b0++" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y0++" Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b*++" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y*++" Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b0" Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b*" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y" Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y*" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y0" Then
For j = iLoading + 1 To peplen + iLoading
If ThisWorkbook.Sheets(2).Cells(j, m).Font.Bold = True Then
If Mid(ThisWorkbook.Sheets(2).Cells(iLoading, m), 1, 1) = "y" Then
PeakInfo(1, i) = ThisWorkbook.Sheets(2).Cells(iLoading, m) & "_" & (peplen - j + iLoading + 1)
PeakInfo(2, i) = ThisWorkbook.Sheets(2).Cells(j, m)
Else
PeakInfo(1, i) = ThisWorkbook.Sheets(2).Cells(iLoading, m) & "_" & (j - iLoading)
Set r = r.Offset(1, 0)
PeakInfo(2, i) = ThisWorkbook.Sheets(2).Cells(j, m)
End If
i = i + 1
End If
Next
End If
Next
End If
ThisWorkbook.Sheets(1).Range(Cells(RowNo, 12), Cells(RowNo + 1, 11 + peakNO)).Select
Selection.Value = PeakInfo
ThisWorkbook.Sheets(2).Activate
Range(Cells(1, 1), Cells(100, 100)).Select
Selection.Delete
Kill sPath & sTxt
sTxt = Dir
Loop
Here is the code:
Dim i As Long, j As Long, RowNo As Long, peakNO As Integer
Dim peplen As Integer, m As Integer, iLoading As Integer, jLoading As Integer
Dim sPath As String, sTxt As String, hits As String
Dim GenInfo(1 To 11) As Variant, PeakInfo() As Variant
Sub extract_info()
ThisWorkbook.Sheets(1).Activate
Application.ScreenUpdating = False
i = 0
RowNo = [l1048576].End(xlUp).Row + 1
If RowNo <> 2 Then
RowNo = RowNo + 1
End If
Set r = Cells(RowNo, 1)
sPath = ThisWorkbook.Path & "\" & "htms\"
sTxt = Dir(sPath & "*.htm")
Do While sTxt <> ""
ThisWorkbook.Sheets(2).Activate
With ActiveSheet.QueryTables.Add(Connection:="finder;file:///" & sPath & sTxt _
, Destination:=Range("$A$1"))
.Name = sTxt
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'---------------------------------------------- Looking for peptide sequence --------------------------------------
GenInfo(1) = Mid(ThisWorkbook.Sheets(2).Cells(5, 1), 24)
peplen = Len(GenInfo(1))
'---------------------------------------------- Looking for protein name --------------------------------------
GenInfo(2) = Mid(ThisWorkbook.Sheets(2).Cells(6, 1), 10, Application.Find(",", ThisWorkbook.Sheets(2).Cells(6, 1)) - 10)
'---------------------------------------------- Looking for precursor mass --------------------------------------
GenInfo(3) = Mid(ThisWorkbook.Sheets(2).Cells(8, 1), Application.Find("(", ThisWorkbook.Sheets(2).Cells(8, 1)) + 1, _
Application.Find(",", ThisWorkbook.Sheets(2).Cells(8, 1)) - Application.Find("(", ThisWorkbook.Sheets(2).Cells(8, 1)) - 1)
'---------------------------------------------- Looking for charge state --------------------------------------
GenInfo(4) = Mid(ThisWorkbook.Sheets(2).Cells(8, 1), Application.Find(",", ThisWorkbook.Sheets(2).Cells(8, 1)) + 1, 2)
'---------------------------------------------- Looking for query number --------------------------------------
GenInfo(5) = Mid(ThisWorkbook.Sheets(2).Cells(8, 1), Application.Find("y", ThisWorkbook.Sheets(2).Cells(8, 1)) + 2, _
Application.Find(":", ThisWorkbook.Sheets(2).Cells(8, 1)) - Application.Find("y", ThisWorkbook.Sheets(2).Cells(8, 1)) - 2)
'---------------------------------------------- Looking for file name --------------------------------------
GenInfo(6) = Mid(ThisWorkbook.Sheets(2).Cells(9, 1), 10)
'---------------------------------------------- Looking for theoretical mass --------------------------------------
If ThisWorkbook.Sheets(2).Cells(14, 2) <> "" Then
GenInfo(7) = ThisWorkbook.Sheets(2).Cells(14, 2)
Else
GenInfo(7) = Mid(ThisWorkbook.Sheets(2).Cells(14, 1), 48)
End If
'---------------------------------------------- Looking for Hit --------------------------------------
GenInfo(8) = Mid(sTxt, Application.Find("hit=", sTxt) + 4, 1)
'********************************************** Loading other infomations **************************************
iLoading = 15
'---------------------------------------------- Looking for fixed modifications --------------------------------------
If Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 1, 5) = "Fixed" Then
GenInfo(9) = Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 22)
iLoading = iLoading + 1
Else
GenInfo(9) = ""
End If
'---------------------------------------------- Looking for Variable modifications --------------------------------------
If Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 1, 8) = "Variable" Then
Do While Mid(ThisWorkbook.Sheets(2).Cells(iLoading + 1, 1), 1, 10) <> "Ions Score" _
And Mid(ThisWorkbook.Sheets(2).Cells(iLoading + 1, 1), 1, 9) <> "Component"
GenInfo(10) = ThisWorkbook.Sheets(2).Cells(iLoading + 1, 1) + " & " + GenInfo(10)
iLoading = iLoading + 1
Loop
iLoading = iLoading + 1
Else
GenInfo(10) = ""
End If
If Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 1, 9) = "Component" Then
iLoading = iLoading + 1
End If
'---------------------------------------------- Looking for ions score ---------------------------------------------------
If Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 1, 10) = "Ions Score" Then
GenInfo(11) = Mid(ThisWorkbook.Sheets(2).Cells(iLoading, 1), 13, 3)
peakNO = Mid(ThisWorkbook.Sheets(2).Cells(iLoading + 1, 1), 21, Application.Find("/", ThisWorkbook.Sheets(2).Cells(iLoading + 1, 1)) - 21)
iLoading = iLoading + 3
End If
ThisWorkbook.Sheets(1).Activate
RowNo = [l1048576].End(xlUp).Row + 1
If RowNo <> 2 Then
RowNo = RowNo + 1
End If
Range(Cells(RowNo, 1), Cells(RowNo, 11)).Value = GenInfo
'************************************************* Import matched peaks ********************************************************
ReDim PeakInfo(1 To 2, 1 To peakNO)
i = 1
If ThisWorkbook.Sheets(2).Cells(iLoading, 1) = "#" Then
For m = 2 To ThisWorkbook.Sheets(2).Cells(iLoading, 130).End(xlToLeft).Column
If ThisWorkbook.Sheets(2).Cells(iLoading, m) = "a" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "Immon." Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b++" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y++" Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b0++" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y0++" Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b*++" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y*++" Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b0" Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "b*" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y" Or _
ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y*" Or ThisWorkbook.Sheets(2).Cells(iLoading, m) = "y0" Then
For j = iLoading + 1 To peplen + iLoading
If ThisWorkbook.Sheets(2).Cells(j, m).Font.Bold = True Then
If Mid(ThisWorkbook.Sheets(2).Cells(iLoading, m), 1, 1) = "y" Then
PeakInfo(1, i) = ThisWorkbook.Sheets(2).Cells(iLoading, m) & "_" & (peplen - j + iLoading + 1)
PeakInfo(2, i) = ThisWorkbook.Sheets(2).Cells(j, m)
Else
PeakInfo(1, i) = ThisWorkbook.Sheets(2).Cells(iLoading, m) & "_" & (j - iLoading)
Set r = r.Offset(1, 0)
PeakInfo(2, i) = ThisWorkbook.Sheets(2).Cells(j, m)
End If
i = i + 1
End If
Next
End If
Next
End If
ThisWorkbook.Sheets(1).Range(Cells(RowNo, 12), Cells(RowNo + 1, 11 + peakNO)).Select
Selection.Value = PeakInfo
ThisWorkbook.Sheets(2).Activate
Range(Cells(1, 1), Cells(100, 100)).Select
Selection.Delete
Kill sPath & sTxt
sTxt = Dir
Loop