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

I have not studied your code in detail. But I suspect you entered into a worksheet object, for example by right-clicking on the worksheet tab and clicking on View Code. If that is the case, in VBA, click on Insert, then Module. Then cut (ctrl+X) the text from the sheet object and paste it into the module. You might also want to remove references to Worksheets("local"), unless your intent is to reference a worksheet that might not be the active worksheet. And the use of ActiveSheet appears to be redundant, or it needs to be changed, depending on your intent. You might need to understand the distinction among the various ways to refer to worksheets implicitly and explicitly. Suppose the code is currently in the Sheet1 object, the ActiveSheet is Sheet2, and the worksheet "local" is Sheet3. That is, there are three different worksheets involved. Then Range("W2") is equivalent to Sheet1.Range("W2"), ActiveSheet.Cells is equivalent to Sheet2.Cells, and Worksheets("local").Cells is equivalent to Sheet3.Cells. If you simply cut-and-paste the code into a normal module without change, Range("W2") will be equivalent to Sheet2.Range("W2"). All the other equivalent references would be the same.

Hello again, i have tried to edit my code to ecxept "ActiveSheet.Cells(rwIndex 1).Select" but when i try to change out " Worksheets("Local" Can someone please help me out please. Thank you

Hi, Am Mon, 5 Aug 2013 21:38:44 +0100 schrieb lostgrave2001: you want to run the code on all sheets? Then try: dim wsh as worksheet Application.ScreenUpdating = False For Each wsh In ActiveWorkbook.Worksheets your code next wsh And change into the code every "Worksheets("local")" and every "ActiveSheet" to wsh Regards Claus B.

Your requirements are no longer clear to me. Based on your original posting, I assumed you wanted to run a macro __manually__ against any active worksheet. You simply wanted to know how to make the macro available to all worksheets, and what coding changes might be needed. Claus assumed you wanted a macro that you would run once and it applied its algorithm to some number of worksheets. Claus's loop selected all worksheets. Your response indicates that you want all but 4 worksheets. In either case, you indicated that you had difficulty applying the changes I suggested. I assume you would have similar difficulties integrated those changes with Claus's suggest. The changes are similar, but not exactly the same. If you still want help with this, please indicate which solution you want: one macro that you run manually for any active worksheet; or a loop like Claus's, but avoiding certain worksheets. And please post the modified code, based on my suggestions, that did not seem to work for you. Finally, please let us know where the macro code currently resides: a worksheet (object) module, located by right-clicking on the worksheet tab and clicking on View Code; or a normal worksheet module, created by clicking on Insert, then Module.

Hello 'joeu2004[_2_] Apologises for late response I was away with no real access to the net. the code below is what tried before with no success. basically I want macro that I can place the following in front "Sheets("Rainbow").Select or "Sheets("local").Select" and the macro will run on that page. failin that I would like it to run on all sheets excep "Sheets("Staff").Select","Sheets("Balance").Select","Sheets("other").Select". Any help is much Appreciated CR Code in current state Sub runtest() ' ' Reset counters iRejCnt = 0 iTotDRVal = 0 iTotCRVal = 0 iRejAdd = 0 Application.ScreenUpdating = False ' Underline and count relevant lines rwIndex = 1 Do Until dim wsh s(rwIndex, 1).Value = "" ' Check if current line is a rejection ActiveSheet.Cells(rwIndex, 1).Select bRejItem = False: bDRItem = False: bCntBal = True: iRejAdd = 1 sline = wsh.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

You can have it either way quite easily. Your choice. See the attached modified code below. Alternatively (better), download "lostGrave.bas" from https://app.box.com/s/qjrdvdm61l1unt7wf0jy, and import it into VBA. Pay close attention to the lines identified as OPTION 1 and OPTION 2. The macro should be in __normal__ VBA module. Import will do that. If you choose to copy-and-paste the text below, be sure to paste into a module created by clicking on Insert, then Module. Note: I have resisted the temptation to try to improve the implementation. I think it can be improved, especially the sequence of "If InStr" statements. But I did not want to risk screwing up logic that might work for you. Also note: I assumed that all references to Range, Cells and Selection are intended to refer to cells in the selected worksheet. To that end, qualifiers like ActiveSheet and wsh are superfluous. If my assumption is wrong, you need to provide more information, namely: what statements are intended to refer to what worksheets. If the following code does not work in some way, please __be_specific__ about in what way it does not. For example, VBA errors (where?)? Or unintended results (explain)? The modified code.... Sub runtest() Application.ScreenUpdating = False ' *** OPTION 1 *** ' remove OPTION 2 below (also Next statement at the end) ' and change the following line as desired Sheets("Rainbow").Select ' *** OPTION 2 *** ' remove OPTION 1 above; and ' change the following line as desired. ' recommended: indent lines between For and Next ' statements Dim ws As Worksheet, skipName As Variant, skipIt As Boolean For Each ws In Sheets skipIt = False For Each skipName In Array("Staff", "Balance", "other") If ws.Name = skipName Then skipIt = True: Exit For Next If skipIt Then GoTo nextWS ws.Select ' Reset counters iRejCnt = 0 iTotDRVal = 0 iTotCRVal = 0 iRejAdd = 0 ' Underline and count relevant lines rwIndex = 1 Do Until Cells(rwIndex, 1).Value = "" ' Check if current line is a rejection Cells(rwIndex, 1).Select bRejItem = False: bDRItem = False: bCntBal = True iRejAdd = 1 sline = 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 ' *** OPTION 2 *** ' remove the following lines if you choose OPTION 1 nextWS: Next ' For Each ws End Sub