Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 61
  • Last Modified:

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 Old Column PositionNew Column PositionNew Formulas needs to be added and change old formula
See Module Posting All

See Attched
Portfolio-V06.xlsm
0
Naresh Patel
Asked:
Naresh Patel
1 Solution
 
Rgonzo1971Commented:
Hi,

pls try
Sub Macro()
strFormulaBuyR1C1 = "=IF(AND(RC[-1]=""I"",RC[-2]<RC[4]),RC[-2],IF(AND(RC[-1]=""I"",RC[-2]>RC[4]),RC[-2]+(RC[-2]*VLOOKUP(R1C1,Setting!R1C1:R71C2,2,FALSE)),IF(AND(RC[-1]=""I"",RC[-2]=RC[4]),RC[-2]+(RC[-2]*VLOOKUP(R1C1,Setting!R1C1:R71C2,2,FALSE)),IF(RC[-1]=""C"",RC[-2]+(RC[-2]*VLOOKUP(R1C1,Setting!R1C1:R71C2,2,FALSE)),""""))))"
strFormulaSellR1C1 = "=IF(AND(RC[-1]=""I"",RC[-2]<RC[-8]),RC[-2],IF(AND(RC[-1]=""I"",RC[-2]>RC[-8]),RC[-2]-(RC[-2]*VLOOKUP(R1C1,Setting!R1C1:R71C2,2,FALSE)),IF(AND(RC[-1]=""I"",RC[-2]=RC[-8]),RC[-2],IF(RC[-1]=""C"",RC[-2]-(RC[-2]*VLOOKUP(R1C1,Setting!R1C1:R71C2,2,FALSE)),""""))))"
strFormulaPandL_R1C1 = "=IF(AND(RC[-8]<>"""",RC[-2]="""",R1C7=""Client""),(RC[-10]*RC[1])-(RC[-10]*RC[-7]),IF(AND(RC[-8]="""",RC[-2]<>"""",R1C7=""Client""),(RC[-4]*RC[-1])-(RC[-4]*RC[1]),IF(AND(RC[-8]<>"""",RC[-2]<>"""",R1C7=""Client""),(RC[-4]*RC[-1])-(RC[-10]*RC[-7]),IF(AND(RC[-8]<>"""",RC[-2]="""",R1C7=""Broker""),(RC[-10]*RC[-7])-(RC[-10]*RC[1]),IF(AND(RC[-8]="""",RC[-2]<>"""",R1C7=""Broker""),(RC[-4]*RC[1])-(RC[-4]*RC[-1]),IF(AND(RC[-8]<>"""",RC[-2]<>"""",R1C7=""Broker""),(RC[-10]*RC[-7])-(RC[-4]*RC[-1]),IF(AND(RC[-8]="""",RC[-2]=""""),"""")))))))"
strFormulaSettlPriceR1C1 = "=IF(AND(RC[-9]=""C"",RC[-3]=""C""),"""",IF(OR(RC[-9]=""C"",RC[-3]=""C""),VLOOKUP(IF(RC[-9]<>"""",RC[-13],IF(RC[-3]<>"""",RC[-7])),SettelmentPrice!R1C1:R500C2,2,FALSE),""""))"
strFormulaOpClR1C1 = "=IF(AND(RC[-14]<>"""",RC[-8]<>""""),""Close"",IF(OR(RC[-14]<>"""",RC[-8]<>""""),""Open"",""""))"
Set OrigSh = Sheets("Posting")
OrigSh.Activate
Set destSh = Sheets(Range("P1").Value)
For Each strType In Array("I", "BOTH", "C")
    For Each c1 In Range(Range("R2"), Range("R" & 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
                destSh.Range("O" & newTrans.Row).FormulaR1C1 = strFormulaOpClR1C1
            End If
        ElseIf c1.Offset(, 4) = "" Then
            Exit For
        End If
    Next
    For Each c1 In Range(Range("W2"), Range("W" & 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
                destSh.Range("O" & newTrans.Row).FormulaR1C1 = strFormulaOpClR1C1
            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

Regards
0
 
Naresh PatelTraderAuthor Commented:
Perfect...& Thanks
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now