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

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert

See if this solution works for you by signing up for a 7 day free trial.

Unlock 1 Answer and 2 Comments.

Try for 7 days”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

Our community of experts have been thoroughly vetted for their expertise and industry experience.

The Distinguished Expert awards are presented to the top veteran and rookie experts to earn the most points in the top 50 topics.