Montichristo
New Member
- Joined
- Aug 25, 2016
- Messages
- 10
Hi,
I have ~95'000 line to catagorise using the below codes. I run the first then the second. I'm using an array in both (i think) but the data is processed very slowly. Can anyone see where I could speed it up please.
Sub Breakdownone()
Dim vdata() As Variant
Dim r As Long
Dim c As Long
Dim maxrows As Long
Dim range As String
Dim ce17string As String
Dim cs16string As String
Dim c1string As String
Dim descrip As String
Dim c1char1 As String
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
c1char1 = Left(c1string, 1)
vdata = ActiveSheet.UsedRange.Value
maxrows = UBound(vdata, 1)
For r = 3 To maxrows
descrip = ""
c1string = vdata(r, 15)
ce17string = vdata(r, 16)
cs16string = vdata(r, 17)
vreturndata = vdata(r, 20)
'ce17string column
Select Case ce17string
Case "1"
descrip = "Hedge Fund"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
'ce16string column
Select Case cs16string
Case "21", "46", "26"
descrip = "Equity"
Case "17", "44", "31", "45", "54"
descrip = "Exchange Traded Fund"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
'c1string column
Select Case c1string
Case "2", "8", "9", "5G"
descrip = "Equity"
Case "6D"
descrip = "Exchange traded Fund"
Case "6C", "6E"
descrip = "Fund"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
'Begins with c1string column
Select Case Left(c1string, 1)
Case "1", "2", "3"
descrip = "Equity"
Case "4", "8", "9"
descrip = "Debt"
Case "5"
descrip = "Derivatives"
Case "C"
descrip = "Commodities"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
Assign:
Worksheets("Client Asset List").Cells(r, 20) = descrip
Application.StatusBar = "Progress: " & r & " of maxrows: " & Format(r / maxrows, "0%")
Next
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Here is the second piece of code:
Sub breakdowntwo()
Dim vdata() As Variant
Dim r As Long
Dim c As Long
Dim maxrows As Long
Dim ce17string As String
Dim cs16string As String
Dim c1string As String
Dim descrip As String
Dim descrip2 As String
Dim depotcode As String
Dim predpcode As String
Dim c1char1 As String
Dim Model As String
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
vdata = ActiveSheet.UsedRange.Value
c1char1 = Left(c1string, 1)
maxrows = UBound(vdata, 1)
For r = 3 To maxrows
descrip = ""
descrip2 = ""
depotcode = vdata(r, 7)
c1string = vdata(r, 15)
ce17string = vdata(r, 16)
cs16string = vdata(r, 17)
Model = vdata(r, 23)
predpcode = Left(depotcode, 3)
' Start the section that covers the Hedge Funds code CE17
Select Case ce17string
Case "1"
descrip = "Hedge Fund"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
' Start the section that covers the code CS16
Select Case cs16string
Case "17", "31", "44", "45"
descrip = "Exchange Traded Fund"
Case "21", "46"
descrip = "Exchange Traded Commodity"
Case "3", "6"
descrip = "Depository Receipt"
Case "20", "26"
descrip = "Real Estate Investment Trust"
Case "30"
descrip = "Venture Capital Trust"
Case "43"
descrip = "Limited Partnership/LLP"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
' Start the section that covers the code C1
Select Case c1string
Case "5F"
descrip = "Structured Product"
Case "4B"
descrip = "Equity Link Note"
Case "41", "42", "43", "44", "45", "46", "47", "48", "49", "4A", "4C", "4D", "4E"
descrip = "Corporate Debt"
Case "8A", "8B", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89"
descrip = "Goverment Debt"
Case "9A", "9B", "90", "91", "92", "93", "94", "95", "96", "97", "98"
descrip = "Goverment Debt"
Case "5G"
descrip = "Depository Receipt"
Case "2", "8", "9", "10", "14", "15", "18", "19"
descrip = "Equity"
Case "5D", "51", "5A", "5E"
descrip = "Warrant"
Case "54"
descrip = "Composite Unit"
Case "20", "21", "23", "24", "31", "32", "34", "35"
descrip = "Preference Share"
Case "6C"
descrip = "Mutual Fund"
Case "6D"
descrip = "Closed Ended Fund"
Case "6E"
descrip = "Other Fund"
Case "99"
descrip = "Misc"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
Assign:
Worksheets("Client Asset List").Cells(r, 21) = descrip
'Platform breakdown
If Model = "B" Then
If descrip = "Mutual Fund" Then
Select Case predpcode
Case "FND", "PCI", "PIL"
descrip2 = "Mutual Fund On Platform"
Case Else
descrip2 = "Mutual Fund Off Platform"
End Select
Else
descrip2 = " "
End If
Else
descrip2 = " "
End If
Worksheets("Client Asset List").Cells(r, 22) = descrip2
Application.StatusBar = "Progress: " & r & " of maxrows: " & Format(r / maxrows, "0%")
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False
Thank you, any help is appreciated.
I have ~95'000 line to catagorise using the below codes. I run the first then the second. I'm using an array in both (i think) but the data is processed very slowly. Can anyone see where I could speed it up please.
Sub Breakdownone()
Dim vdata() As Variant
Dim r As Long
Dim c As Long
Dim maxrows As Long
Dim range As String
Dim ce17string As String
Dim cs16string As String
Dim c1string As String
Dim descrip As String
Dim c1char1 As String
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
c1char1 = Left(c1string, 1)
vdata = ActiveSheet.UsedRange.Value
maxrows = UBound(vdata, 1)
For r = 3 To maxrows
descrip = ""
c1string = vdata(r, 15)
ce17string = vdata(r, 16)
cs16string = vdata(r, 17)
vreturndata = vdata(r, 20)
'ce17string column
Select Case ce17string
Case "1"
descrip = "Hedge Fund"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
'ce16string column
Select Case cs16string
Case "21", "46", "26"
descrip = "Equity"
Case "17", "44", "31", "45", "54"
descrip = "Exchange Traded Fund"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
'c1string column
Select Case c1string
Case "2", "8", "9", "5G"
descrip = "Equity"
Case "6D"
descrip = "Exchange traded Fund"
Case "6C", "6E"
descrip = "Fund"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
'Begins with c1string column
Select Case Left(c1string, 1)
Case "1", "2", "3"
descrip = "Equity"
Case "4", "8", "9"
descrip = "Debt"
Case "5"
descrip = "Derivatives"
Case "C"
descrip = "Commodities"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
Assign:
Worksheets("Client Asset List").Cells(r, 20) = descrip
Application.StatusBar = "Progress: " & r & " of maxrows: " & Format(r / maxrows, "0%")
Next
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Here is the second piece of code:
Sub breakdowntwo()
Dim vdata() As Variant
Dim r As Long
Dim c As Long
Dim maxrows As Long
Dim ce17string As String
Dim cs16string As String
Dim c1string As String
Dim descrip As String
Dim descrip2 As String
Dim depotcode As String
Dim predpcode As String
Dim c1char1 As String
Dim Model As String
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
vdata = ActiveSheet.UsedRange.Value
c1char1 = Left(c1string, 1)
maxrows = UBound(vdata, 1)
For r = 3 To maxrows
descrip = ""
descrip2 = ""
depotcode = vdata(r, 7)
c1string = vdata(r, 15)
ce17string = vdata(r, 16)
cs16string = vdata(r, 17)
Model = vdata(r, 23)
predpcode = Left(depotcode, 3)
' Start the section that covers the Hedge Funds code CE17
Select Case ce17string
Case "1"
descrip = "Hedge Fund"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
' Start the section that covers the code CS16
Select Case cs16string
Case "17", "31", "44", "45"
descrip = "Exchange Traded Fund"
Case "21", "46"
descrip = "Exchange Traded Commodity"
Case "3", "6"
descrip = "Depository Receipt"
Case "20", "26"
descrip = "Real Estate Investment Trust"
Case "30"
descrip = "Venture Capital Trust"
Case "43"
descrip = "Limited Partnership/LLP"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
' Start the section that covers the code C1
Select Case c1string
Case "5F"
descrip = "Structured Product"
Case "4B"
descrip = "Equity Link Note"
Case "41", "42", "43", "44", "45", "46", "47", "48", "49", "4A", "4C", "4D", "4E"
descrip = "Corporate Debt"
Case "8A", "8B", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89"
descrip = "Goverment Debt"
Case "9A", "9B", "90", "91", "92", "93", "94", "95", "96", "97", "98"
descrip = "Goverment Debt"
Case "5G"
descrip = "Depository Receipt"
Case "2", "8", "9", "10", "14", "15", "18", "19"
descrip = "Equity"
Case "5D", "51", "5A", "5E"
descrip = "Warrant"
Case "54"
descrip = "Composite Unit"
Case "20", "21", "23", "24", "31", "32", "34", "35"
descrip = "Preference Share"
Case "6C"
descrip = "Mutual Fund"
Case "6D"
descrip = "Closed Ended Fund"
Case "6E"
descrip = "Other Fund"
Case "99"
descrip = "Misc"
End Select
If descrip = "" Then
Else
GoTo Assign
End If
Assign:
Worksheets("Client Asset List").Cells(r, 21) = descrip
'Platform breakdown
If Model = "B" Then
If descrip = "Mutual Fund" Then
Select Case predpcode
Case "FND", "PCI", "PIL"
descrip2 = "Mutual Fund On Platform"
Case Else
descrip2 = "Mutual Fund Off Platform"
End Select
Else
descrip2 = " "
End If
Else
descrip2 = " "
End If
Worksheets("Client Asset List").Cells(r, 22) = descrip2
Application.StatusBar = "Progress: " & r & " of maxrows: " & Format(r / maxrows, "0%")
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False
Thank you, any help is appreciated.