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.ActivateSet 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 NextNextEnd SubFunction 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 0End Function