Link to home
Start Free TrialLog in
Avatar of Naresh Patel
Naresh PatelFlag for India

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.
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

Open in new window

This is original code i need changes in this as User generated imageUser generated imageUser generated image
See Module Posting All

See Attched
Portfolio-V06.xlsm
ASKER CERTIFIED SOLUTION
Avatar of Rgonzo1971
Rgonzo1971

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Naresh Patel

ASKER

Perfect...& Thanks