L

#### lostgrave2001

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