TD.NG
11-16-2012, 09:08 PM
Hello,
I writed codes in VBA and have some problems:
- my code is too long (i'm new to VBA)
- code in red doesn't work
- My real data reaches 4000 lines and it doesn't work at all (in fact, it go on mode "not responding" and i'm forced to restart my computer)
Thanks for your help.
Here the code:
Sub Filter()
Dim rData As Range, rtarget As Range, rcrit As Range, i As Long, j As Long
On Error Resume Next
''' clear Filter
Sheets("Filter").Cells.Select
Selection.ClearContents
'''' condition: Value date> report date va Trade date <= report date
With Sheets("Data")
Set rData = .Range("A4:W400")
Set rtarget = Sheets("Filter").Range("A4:W400")
rtarget.Parent.UsedRange.ClearContents
rtarget.Parent.Range("Iv1").Value = .Range("L4").Value
rtarget.Parent.Range("iu1").Value = .Range("Q4").Value
rtarget.Parent.Range("IU2").Value = "<=" & CLng(.Range("A1").Value)
rtarget.Parent.Range("IV2").Value = ">" & CLng(.Range("A1").Value)
Set rcrit = rtarget.Parent.Range("IU1:IV2")
rData.AdvancedFilter 2, rcrit, rtarget
rcrit.ClearContents
End With
With Sheets("DataInput")
Sheets("DataInput").Cells.Select
Selection.ClearContents
Set rinput = .Range("A4:K400")
rinput(1, 1).Value = "Contracts"
rinput(1, 2).Value = "CCY bought"
rinput(1, 3).Value = "Value.date.buy"
rinput(1, 4).Value = "Amt bought"
rinput(1, 5).Value = "CCY sold"
rinput(1, 6).Value = "Value.date.sell"
rinput(1, 7).Value = "Amt sold"
rinput(1, 8).Value = "time remaining"
rinput(1, 9).Value = "timeband"
'''' seperate amount sell/buy
For i = 2 To 400
If rtarget(i, 3) = "BUY" Or rtarget(i, 3) = "Buy" Or rtarget(i, 3) = "buy" Then
rinput(i, 2) = rtarget(i, 5)
rinput(i, 3) = rtarget(i, 12)
rinput(i, 4) = rtarget(i, 6)
rinput(i, 5) = rtarget(i, 8)
rinput(i, 7) = rtarget(i, 10)
rinput(i, 6) = rtarget(i, 12)
Else
rinput(i, 5) = rtarget(i, 5)
rinput(i, 6) = rtarget(i, 12)
rinput(i, 7) = rtarget(i, 6)
rinput(i, 2) = rtarget(i, 8)
rinput(i, 3) = rtarget(i, 12)
rinput(i, 4) = rtarget(i, 10)
End If
rinput(i, 1) = rtarget(i, 1)
rinput(i, 8).Value = rinput(i, 6).Value - Sheets("Data").Range("A1").Value
If rinput(i, 8) <> "" Then
rinput(i, 9) = Application.WorksheetFunction.VLookup(rinput(i, 8), Sheet3.Range("A1:B10"), 2, 1)
Else: rinput(i, 9) = ""
End If
Next i
End With
End Sub
And the file
I writed codes in VBA and have some problems:
- my code is too long (i'm new to VBA)
- code in red doesn't work
- My real data reaches 4000 lines and it doesn't work at all (in fact, it go on mode "not responding" and i'm forced to restart my computer)
Thanks for your help.
Here the code:
Sub Filter()
Dim rData As Range, rtarget As Range, rcrit As Range, i As Long, j As Long
On Error Resume Next
''' clear Filter
Sheets("Filter").Cells.Select
Selection.ClearContents
'''' condition: Value date> report date va Trade date <= report date
With Sheets("Data")
Set rData = .Range("A4:W400")
Set rtarget = Sheets("Filter").Range("A4:W400")
rtarget.Parent.UsedRange.ClearContents
rtarget.Parent.Range("Iv1").Value = .Range("L4").Value
rtarget.Parent.Range("iu1").Value = .Range("Q4").Value
rtarget.Parent.Range("IU2").Value = "<=" & CLng(.Range("A1").Value)
rtarget.Parent.Range("IV2").Value = ">" & CLng(.Range("A1").Value)
Set rcrit = rtarget.Parent.Range("IU1:IV2")
rData.AdvancedFilter 2, rcrit, rtarget
rcrit.ClearContents
End With
With Sheets("DataInput")
Sheets("DataInput").Cells.Select
Selection.ClearContents
Set rinput = .Range("A4:K400")
rinput(1, 1).Value = "Contracts"
rinput(1, 2).Value = "CCY bought"
rinput(1, 3).Value = "Value.date.buy"
rinput(1, 4).Value = "Amt bought"
rinput(1, 5).Value = "CCY sold"
rinput(1, 6).Value = "Value.date.sell"
rinput(1, 7).Value = "Amt sold"
rinput(1, 8).Value = "time remaining"
rinput(1, 9).Value = "timeband"
'''' seperate amount sell/buy
For i = 2 To 400
If rtarget(i, 3) = "BUY" Or rtarget(i, 3) = "Buy" Or rtarget(i, 3) = "buy" Then
rinput(i, 2) = rtarget(i, 5)
rinput(i, 3) = rtarget(i, 12)
rinput(i, 4) = rtarget(i, 6)
rinput(i, 5) = rtarget(i, 8)
rinput(i, 7) = rtarget(i, 10)
rinput(i, 6) = rtarget(i, 12)
Else
rinput(i, 5) = rtarget(i, 5)
rinput(i, 6) = rtarget(i, 12)
rinput(i, 7) = rtarget(i, 6)
rinput(i, 2) = rtarget(i, 8)
rinput(i, 3) = rtarget(i, 12)
rinput(i, 4) = rtarget(i, 10)
End If
rinput(i, 1) = rtarget(i, 1)
rinput(i, 8).Value = rinput(i, 6).Value - Sheets("Data").Range("A1").Value
If rinput(i, 8) <> "" Then
rinput(i, 9) = Application.WorksheetFunction.VLookup(rinput(i, 8), Sheet3.Range("A1:B10"), 2, 1)
Else: rinput(i, 9) = ""
End If
Next i
End With
End Sub
And the file