Hello
Could anyone show me how to change the following macro to activie 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) Then bRejItem = True: iRejAdd = 1

If InStr(1, sline, "REJECTED TRANSACTION PARTIAL", 1) Then 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: iRejAdd = 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) And 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) Then 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

CR