Naresh Patel
asked on
Portfolio V7
I had this question after viewing Step By Step Incorporated.
Hi Experts,
above link question - macro is perfect doing its job but now i had changed formula and one column position so need some changes in existing code.
See Module Posting All
See Attched
Portfolio-V06.xlsm
Hi Experts,
above link question - macro is perfect doing its job but now i had changed formula and one column position so need some changes in existing code.
Sub Macro()
strFormulaBuyR1C1 = "=IF(AND(RC[-1]=""I"",RC[-2]<RC[4]),RC[-2],IF(RC[-1]<>"""",RC[-2]+(RC[-2]*VLOOKUP(R1C1,Setting!R1C1:R71C2,2,FALSE)),""""))"
strFormulaSellR1C1 = "=IF(AND(RC[-1]=""I"",RC[-2]<RC[-8]),RC[-2],IF(RC[-1]<>"""",RC[-2]-(RC[-2]*VLOOKUP(R1C1,Setting!R1C1:R71C2,2,FALSE)),""""))"
strFormulaPandL_R1C1 = "=IFERROR(IF(AND(RC[-8]<>"""",RC[-2]=""""),(RC[-10]*RC[1])-(RC[-10]*RC[-7]),IF(AND(RC[-8]="""",RC[-2]<>""""),(RC[-4]*RC[-1])-(RC[-4]*RC[1]),(RC[-4]*RC[-1])-(RC[-10]*RC[-7]))),0)"
strFormulaSettlPriceR1C1 = "=IF((RC[-9]=""C"")=(NOT(RC[-3]=""C"")),VLOOKUP(IF(RC[-9]<>"""",RC[-13],IF(RC[-3]<>"""",RC[-7])),SettelmentPrice!R1C1:R500C2,2,FALSE),"""")"
Set OrigSh = Sheets("Posting")
OrigSh.Activate
Set destSh = Sheets(Range("O1").Value)
For Each strType In Array("I", "BOTH", "C")
For Each c1 In Range(Range("Q2"), Range("Q" & Rows.Count).End(xlUp))
If c1.Offset(, 4) = strType Then
dblAmount = c1.Offset(, 2)
For Each c2 In destSh.Range(destSh.Range("G2"), destSh.Range("G" & Rows.Count).End(xlUp))
If dblAmount > 0 And c1 = c2 And destSh.Range("A" & c2.Row) = "" Then
Set newTrans = destSh.Range("A" & c2.Row)
newTrans.Value = c1
newTrans.Offset(, 1).Value = c1.Offset(, 1).Value
newTrans.Offset(, 2) = WorksheetFunction.Min(c1.Offset(, 2), c2.Offset(, 2))
newTrans.Offset(, 3) = c1.Offset(, 3)
strCode = IIf(c1.Offset(, 4) = "BOTH", IIf(c1.Offset(, 1) = c2.Offset(, 1), "I", "C"), c1.Offset(, 4))
newTrans.Offset(, 4) = strCode
dblAmount = dblAmount - c2.Offset(, 2)
newTrans.Offset(, 5).FormulaR1C1 = strFormulaBuyR1C1
End If
Next
If dblAmount > 0 Then
lstRow = LastRow(destSh.Name)
Set newTrans = destSh.Range("A" & lstRow).Offset(1)
newTrans.Value = c1
newTrans.Offset(, 1) = c1.Offset(, 1)
newTrans.Offset(, 2) = dblAmount
newTrans.Offset(, 3) = c1.Offset(, 3)
newTrans.Offset(, 4) = IIf(c1.Offset(, 4) = "I", "I", "C")
newTrans.Offset(, 5).FormulaR1C1 = strFormulaBuyR1C1
destSh.Range("M" & newTrans.Row).FormulaR1C1 = strFormulaPandL_R1C1
destSh.Range("N" & newTrans.Row).FormulaR1C1 = strFormulaSettlPriceR1C1
End If
ElseIf c1.Offset(, 4) = "" Then
Exit For
End If
Next
For Each c1 In Range(Range("V2"), Range("V" & Rows.Count).End(xlUp))
If c1.Offset(, 4) = strType Then
dblAmount = c1.Offset(, 2)
For Each c2 In destSh.Range(destSh.Range("A2"), destSh.Range("A" & Rows.Count).End(xlUp))
If dblAmount > 0 And c1 = c2 And destSh.Range("G" & c2.Row) = "" Then
Set newTrans = destSh.Range("G" & c2.Row)
newTrans.Value = c1
newTrans.Offset(, 1) = c1.Offset(, 1)
newTrans.Offset(, 2) = WorksheetFunction.Min(c1.Offset(, 2), c2.Offset(, 2))
newTrans.Offset(, 3) = c1.Offset(, 3)
strCode = IIf(c1.Offset(, 4) = "BOTH", IIf(c1.Offset(, 1) = c2.Offset(, 1), "I", "C"), c1.Offset(, 4))
newTrans.Offset(, 4) = strCode
dblAmount = dblAmount - c2.Offset(, 2)
newTrans.Offset(, 5).FormulaR1C1 = strFormulaSellR1C1
End If
Next
If dblAmount > 0 Then
lstRow = LastRow(destSh.Name)
Set newTrans = destSh.Range("G" & lstRow).Offset(1)
newTrans.Value = c1
newTrans.Offset(, 1) = c1.Offset(, 1)
newTrans.Offset(, 2) = dblAmount
newTrans.Offset(, 3) = c1.Offset(, 3)
newTrans.Offset(, 4) = IIf(c1.Offset(, 4) = "I", "I", "C")
newTrans.Offset(, 5).FormulaR1C1 = strFormulaSellR1C1
destSh.Range("M" & newTrans.Row).FormulaR1C1 = strFormulaPandL_R1C1
destSh.Range("N" & newTrans.Row).FormulaR1C1 = strFormulaSettlPriceR1C1
End If
ElseIf c1.Offset(, 4) = "" Then
Exit For
End If
Next
Next
End Sub
Function LastRow(sh As String)
On Error Resume Next
LastRow = Sheets(sh).Cells.Find(What:="*", _
After:=Sheets(sh).Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
This is original code i need changes in this as See Module Posting All
See Attched
Portfolio-V06.xlsm
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER