Hello Could anyone show me how to change the following macro to activi sheet/tab rather than having to create a new macro for every tab. Sub runlocal() ' ' Reset local iRejCnt = 0 iTotDRVal = 0 iTotCRVal = 0 iRejAdd = 0 Application.ScreenUpdating = False ' Underline and count relevant lines rwIndex = 1 Do Until Worksheets("local").Cells(rwIndex, 1).Value = "" ' Check if current line is a rejection ActiveSheet.Cells(rwIndex, 1).Select bRejItem = False: bDRItem = False: bCntBal = True: iRejAdd = 1 sline = Worksheets("local").Cells(rwIndex, 1).Value If InStr(1, sline, "REJECTED TRANSACTION", 1) Then bRejItem True: iRejAdd = 1 If InStr(1, sline, "INVALID TRANSACTION", 1) Then bRejItem True: iRejAdd = 1 If InStr(1, sline, "EARLY SETTLEMENT OF", 1) Then bRejItem False: bCntBal = True: iRejAdd = 1 If InStr(1, sline, "CURRENT SETTLEMENT", 1) Then bRejItem True: bCntBal = False: iRejAdd = 1 If InStr(1, sline, "PARTIAL PAYMENT", 1) Then bRejItem = True bCntBal = True: iRejAdd = 1 If InStr(1, sline, "REJECTED DUE TO REBATE DISCREPANCY", 1) The bRejItem = True: iRejAdd = 1 If InStr(1, sline, "REJECTED TRANSACTION PARTIAL", 1) The bRejItem = True: iRejAdd = 0 If InStr(1, sline, "ACCOUNT TOTAL TO DATE", 1) Then bRejItem False: iRejAdd = 0: bCntBal = False If InStr(1, sline, "FEES IN TRANSIT", 1) Then bRejItem = False iRejAdd = 0: bCntBal = False If InStr(1, sline, "REBATES IN TRANSIT", 1) Then bRejItem False: iRejAdd = 0: bCntBal = False If InStr(1, sline, "INTEREST IN TRANSIT", 1) Then bRejItem False: iRejAdd = 0: bCntBal = False If InStr(1, sline, "PREMIUM IN TRANSIT", 1) Then bRejItem False: iRejAdd = 0: bCntBal = False If InStr(1, sline, "LEDGER BALANCE", 1) Then bRejItem = False iRejAdd = 0: bCntBal = False If InStr(1, sline, "THE BALANCE", 1) Then bRejItem = False iRejAdd = 0: bCntBal = False If InStr(1, sline, "TODAYS TRANSACTION", 1) Then bRejItem False: iRejAdd = 0: bCntBal = False If InStr(1, sline, "CREDITOR INTEREST", 1) Then bRejItem False: iRejAdd = 0: bCntBal = False If InStr(1, sline, "DIFFERENCE", 1) Then bRejItem = False iRejAdd = 0: bCntBal = False If InStr(1, sline, "INITIALS", 1) Then bRejItem = False: iRejAd = 0: bCntBal = False If InStr(37, sline, "DR", 1) Then bRejItem = True: bDRItem True ' Calculate figure to add to balancing totals If bCntBal = True Then sRejValue = "": bFndNum = False sline = Selection.Value For iExtNum = 40 To Len(sline) sLineExt = Mid$(sline, iExtNum, 1) If sLineExt >= Chr(46) And sLineExt <= Chr(57) An bFndNum = False Then sRejValue = sRejValue & sLineExt If sLineExt > Chr(57) And sRejValue <> "" Then bFndNum True Next iExtNum If bRejItem = False Then iTotCRVal = iTotCRVal Val(sRejValue) End If ' Underline report line If bRejItem = True Then LASTROW = rwIndex iRejCnt = iRejCnt + iRejAdd Selection.Borders(xlEdgeBottom).Weight = xlHairline If bDRItem = True Then Selection.Interior.ColorIndex = 35 If bCntBal = True Then iTotDRVal = iTotDRVal Val(sRejValue) Else Selection.Interior.ColorIndex = xlNone If bCntBal = True Then iTotCRVal = iTotCRVal Val(sRejValue) End If If iRejCnt > 0 And iRejCnt / 20 = Int(iRejCnt / 20) The Range("B" & rwIndex) = iRejCnt End If rwIndex = rwIndex + 1 Loop Range("W2") = rwIndex - 1 ' Total of CR/DR for bottom of printout Range("A" & rwIndex) = "Total CR Value = " & iTotDRVal Range("A" & rwIndex + 1) = "Total DR Value = " & iTotCRVal Range("T2") = iTotCRVal Range("S2") = iTotDRVal Range("x2") = LASTROW - 1 ' End Sub Thank you in Advance C