Macro Help

[lostgrave2001]

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

 

[joeu2004]

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. [....]
Do Until Worksheets("local").Cells(rwIndex, 1).Value = "" [....]
ActiveSheet.Cells(rwIndex, 1).Select [....]
sline = Worksheets("local").Cells(rwIndex, 1).Value [....]
Range("W2") = rwIndex - 1

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.

 

[lostgrave2001]

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

;1613054']"lostgrave2001" <[email protected]
wrote:-

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.- [....]-
Do Until Worksheets("local").Cells(rwIndex, 1).Value = ""- [....]-
ActiveSheet.Cells(rwIndex, 1).Select- [....]-
sline = Worksheets("local").Cells(rwIndex, 1).Value- [....]-
Range("W2") = rwIndex - 1-

I have not studied your code in detail. But I suspect you entered int
a
worksheet object, for example by right-clicking on the worksheet tab an

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"), unles
your
intent is to reference a worksheet that might not be the activ
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 t
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.Cell
is
equivalent to Sheet2.Cells, and Worksheets("local").Cells is equivalen
to
Sheet3.Cells.

If you simply cut-and-paste the code into a normal module withou
change,
Range("W2") will be equivalent to Sheet2.Range("W2"). All the other
equivalent references would be the same

 

[Claus Busch]

Hi,

Am Mon, 5 Aug 2013 21:38:44 +0100 schrieb lostgrave2001:

i have tried to edit my code to ecxept "ActiveSheet.Cells(rwIndex,
1).Select" but when i try to change out " Worksheets("Local"

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.

 

[lostgrave2001]

There would be 4 sheets i couldnt have the macro run on.

Kind regards

Chris

 

[joeu2004]

There would be 4 sheets i couldnt have the macro run on.

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.

 

[lostgrave2001]

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

;1613262']"lostgrave2001" <[email protected]
wrote:-

There would be 4 sheets i couldnt have the macro run on.-

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.

 

[joeu2004]

the code below is what tried before with no success.
basically I want a macro that I can place the following
in front "Sheets("Rainbow").Select" or "Sheets("local").Select"
and the macro will run on that page. failing that I would like
it to run on all sheets except "Sheets("Staff").Select",
"Sheets("Balance").Select","Sheets("other").Select".

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