I have a workbook where our specialists enter their activities by
alphanumeric code. (Some codes alpha, some numeric, none mixed). Each
specialist has 2 sheets in the workbook. One in which they report their
work, another that tallies the work by code and month and creates a
graph for them and others to look for trends, etc. The macro I've
written, with this NG's help, is run when a specialist's monthy tally
sheet is selected. The macro goes to the entry, or source, sheet, and
checks each cell in the specified range for certain codes. If it finds
an appropriate code, it checks another cell to see if it has a
recognizable date. If these criteria are met, it tallies the number of
times a giving code occurs in each month of the year. If the criteria
are not met, it skips to the next cell. One of the codes, 16, has
tallied subcodes as well (A, R, B, G). It all works fine.
I've been writing VBA macros for about 8 months now, and my progress
has been slow. I want to get better at this.
What I'm interested in is how to streamline the code, if possible. How
would someone do the same thing with less code? Speed is not important
in this application, no specialist has more than a 1000 entries. But
what if it were? How would you make this run even faster?
I'm particularly interested in better ways to do the subcodes. I've
marked this part of the macro.
I'd also appreciate feedback on formatting and comments. Any way to
make it easier to come back later and debug or change the code.
Thanks for any feedback.

Sub SpecMonthCount()

Dim lngRsnCode As Long 'Reason Code from source sheet
Dim wksSrc As Worksheet 'source worksheet, where specicalists enter
their counts
Dim wksSpecMon As Worksheet 'Monthly sheet, where the counts are
tallied by month
Dim wksTot As Worksheet 'TOTALS worksheet where the vlookup for tally
column & row is determined
Dim rngCode As Range 'range in which codes are stored
Dim lEndRow As Long 'no of rows to check for values
Dim strMonWksht As String 'current Monthly worksheet name
Dim dteColCode As Date 'date of contact taken from source sheet
Dim lngCntctMo As Long 'month taken from contact date
Dim lngMoRow As Long 'the appropriate row where that months tally is
entered
Dim rngCell As Range 'current cell from which reason code is taken
Dim varColCode As Variant 'date taken from Contact Date field
Dim strColCode As String 'column where current data is tallied
determined by vlookup in TOTALS sheet
Dim lCt As Long 'counter for subcategories of category 16 (CIR's, sub
cat A, B, G, R)
Dim rng16Code As Range 'starting point for entering cat 16 sub cats
Dim strSrc As String 'name of source sheet gotten by extracting from
selected montly sheet
Dim strSpecMon As String 'name of specialist's monthly sheet

Const PWORD As String = "2005totals"
lEndRow = 1000
Set wksSpecMon = ActiveSheet
Set wksTot = ActiveWorkbook.Sheets("TOTALS")
strSpecMon = wksSpecMon.Name

'Get source sheet name from monthly sheet name
strSrc = Left(strSpecMon, Len(strSpecMon) - 10)
Set wksSrc = Sheets(strSrc)

Set rngCode = wksSrc.Range("D8:D" & lEndRow)
wksTot.Unprotect Password:=PWORD

wksSpecMon.Range("B4:K15").ClearContents

For Each rngCell In rngCode

dteColCode = 0

Select Case rngCell
Case 1, 14, 4, 13, 3, 7, 16

Set varColCode = rngCell.Offset(0, 5)

'if there's a comma in the code value, skip to the next cell
If InStr(1, varColCode, ",") = 0 Then

'if the code cell is blank, skip to the next cell
If Trim(varColCode.Value) < "" Then

'if the code is not a date, procede to the next
step
On Error Resume Next
dteColCode = DateValue(varColCode.Value)

'reset error handling to default
On Error GoTo 0

'if the code cell is blank, skip to the next cell
If dteColCode < Empty Then
'extract the month from the date field,
' add 3 to get the row to enter the count in
lngCntctMo = Month(dteColCode)
lngMoRow = lngCntctMo + 3

'enter the reason code into the Totals sheet
' and do a vlookup to get the column to enter the
code in
lngRsnCode = rngCell.Value
wksTot.Range("AC1") = lngRsnCode
strColCode = wksTot.Range("AC2")
wksSpecMon.Cells(lngMoRow, strColCode) = _
wksSpecMon.Cells(lngMoRow, strColCode) + 1

'test if cat 16
If rngCell = "16" Then <---SUBCODE PROCEDURE
START
'determine starting point for cat 16
sub cat tally
Set rng16Code =
wksSpecMon.Cells(lngMoRow, strColCode)
'tally cell if cat R
lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "R")
If lCt 0 Then
rng16Code.Offset(0, 1) = _
rng16Code.Offset(0, 1) + 1

lCt = 0
End If

lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "A")
If lCt 0 Then
rng16Code.Offset(0, 2) = _
rng16Code.Offset(0, 2) + 1
lCt = 0
End If

lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "B")
If lCt 0 Then
rng16Code.Offset(0, 3) = _
rng16Code.Offset(0, 3) + 1
Else
lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "G")
If lCt 0 Then
rng16Code.Offset(0, 3) = _
rng16Code.Offset(0, 3) + 1
lCt = 0
End If

End If <---SUBCODE PROCEDURE ENDS
End If
End If
End If
End If

End Select
Next rngCell

End Sub

1) strColCode = wksTot.Range("AC2")
Any variables that can be set before you start your loop, should be.
Otherwise, if you have 1000 cells in your loop you are setting it 999 times
unneccessarily. "A billion here, a billion there. Pretty soon we're talking
real money..."

2) If A, R, B, G subcodes are mutually exclusive (i.e., any given record
might have one, but only one of those codes) then you might consider the
following structu

Set rng16Code = wksSpecMon.Cells(lngMoRow, strColCode)

Select Case True
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "R") 0
rng16Code.Offset(0, 1) = rng16Code.Offset(0, 1) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "A") 0
rng16Code.Offset(0, 2) = rng16Code.Offset(0, 2) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "B") 0
rng16Code.Offset(0, 3) = rng16Code.Offset(0, 3) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "G") 0
rng16Code.Offset(0, 3) = rng16Code.Offset(0, 3) + 1
Case Else
'Do nothing
End Select

HTH,
--
George Nicholson

Remove 'Junk' from return address.


"davegb" wrote in message
oups.com...
I have a workbook where our specialists enter their activities by
alphanumeric code. (Some codes alpha, some numeric, none mixed). Each
specialist has 2 sheets in the workbook. One in which they report their
work, another that tallies the work by code and month and creates a
graph for them and others to look for trends, etc. The macro I've
written, with this NG's help, is run when a specialist's monthy tally
sheet is selected. The macro goes to the entry, or source, sheet, and
checks each cell in the specified range for certain codes. If it finds
an appropriate code, it checks another cell to see if it has a
recognizable date. If these criteria are met, it tallies the number of
times a giving code occurs in each month of the year. If the criteria
are not met, it skips to the next cell. One of the codes, 16, has
tallied subcodes as well (A, R, B, G). It all works fine.
I've been writing VBA macros for about 8 months now, and my progress
has been slow. I want to get better at this.
What I'm interested in is how to streamline the code, if possible. How
would someone do the same thing with less code? Speed is not important
in this application, no specialist has more than a 1000 entries. But
what if it were? How would you make this run even faster?
I'm particularly interested in better ways to do the subcodes. I've
marked this part of the macro.
I'd also appreciate feedback on formatting and comments. Any way to
make it easier to come back later and debug or change the code.
Thanks for any feedback.

Sub SpecMonthCount()

Dim lngRsnCode As Long 'Reason Code from source sheet
Dim wksSrc As Worksheet 'source worksheet, where specicalists enter
their counts
Dim wksSpecMon As Worksheet 'Monthly sheet, where the counts are
tallied by month
Dim wksTot As Worksheet 'TOTALS worksheet where the vlookup for tally
column & row is determined
Dim rngCode As Range 'range in which codes are stored
Dim lEndRow As Long 'no of rows to check for values
Dim strMonWksht As String 'current Monthly worksheet name
Dim dteColCode As Date 'date of contact taken from source sheet
Dim lngCntctMo As Long 'month taken from contact date
Dim lngMoRow As Long 'the appropriate row where that months tally is
entered
Dim rngCell As Range 'current cell from which reason code is taken
Dim varColCode As Variant 'date taken from Contact Date field
Dim strColCode As String 'column where current data is tallied
determined by vlookup in TOTALS sheet
Dim lCt As Long 'counter for subcategories of category 16 (CIR's, sub
cat A, B, G, R)
Dim rng16Code As Range 'starting point for entering cat 16 sub cats
Dim strSrc As String 'name of source sheet gotten by extracting from
selected montly sheet
Dim strSpecMon As String 'name of specialist's monthly sheet

Const PWORD As String = "2005totals"
lEndRow = 1000
Set wksSpecMon = ActiveSheet
Set wksTot = ActiveWorkbook.Sheets("TOTALS")
strSpecMon = wksSpecMon.Name

'Get source sheet name from monthly sheet name
strSrc = Left(strSpecMon, Len(strSpecMon) - 10)
Set wksSrc = Sheets(strSrc)

Set rngCode = wksSrc.Range("D8:D" & lEndRow)
wksTot.Unprotect Password:=PWORD

wksSpecMon.Range("B4:K15").ClearContents

For Each rngCell In rngCode

dteColCode = 0

Select Case rngCell
Case 1, 14, 4, 13, 3, 7, 16

Set varColCode = rngCell.Offset(0, 5)

'if there's a comma in the code value, skip to the next cell
If InStr(1, varColCode, ",") = 0 Then

'if the code cell is blank, skip to the next cell
If Trim(varColCode.Value) < "" Then

'if the code is not a date, procede to the next
step
On Error Resume Next
dteColCode = DateValue(varColCode.Value)

'reset error handling to default
On Error GoTo 0

'if the code cell is blank, skip to the next cell
If dteColCode < Empty Then
'extract the month from the date field,
' add 3 to get the row to enter the count in
lngCntctMo = Month(dteColCode)
lngMoRow = lngCntctMo + 3

'enter the reason code into the Totals sheet
' and do a vlookup to get the column to enter the
code in
lngRsnCode = rngCell.Value
wksTot.Range("AC1") = lngRsnCode
strColCode = wksTot.Range("AC2")
wksSpecMon.Cells(lngMoRow, strColCode) = _
wksSpecMon.Cells(lngMoRow, strColCode) + 1

'test if cat 16
If rngCell = "16" Then <---SUBCODE PROCEDURE
START
'determine starting point for cat 16
sub cat tally
Set rng16Code =
wksSpecMon.Cells(lngMoRow, strColCode)
'tally cell if cat R
lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "R")
If lCt 0 Then
rng16Code.Offset(0, 1) = _
rng16Code.Offset(0, 1) + 1

lCt = 0
End If

lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "A")
If lCt 0 Then
rng16Code.Offset(0, 2) = _
rng16Code.Offset(0, 2) + 1
lCt = 0
End If

lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "B")
If lCt 0 Then
rng16Code.Offset(0, 3) = _
rng16Code.Offset(0, 3) + 1
Else
lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "G")
If lCt 0 Then
rng16Code.Offset(0, 3) = _
rng16Code.Offset(0, 3) + 1
lCt = 0
End If

End If <---SUBCODE PROCEDURE ENDS
End If
End If
End If
End If

End Select
Next rngCell

End Sub

George,
Thanks for your reply.

George Nicholson wrote:
1) strColCode = wksTot.Range("AC2")
Any variables that can be set before you start your loop, should be.
Otherwise, if you have 1000 cells in your loop you are setting it 999 times
unneccessarily. "A billion here, a billion there. Pretty soon we're talking
real money..."

In this case, the variable is being determined by a vlookup initiated
by the previous step, and has to be done every time.


2) If A, R, B, G subcodes are mutually exclusive (i.e., any given record
might have one, but only one of those codes) then you might consider the
following structu

Set rng16Code = wksSpecMon.Cells(lngMoRow, strColCode)

Select Case True
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "R") 0
rng16Code.Offset(0, 1) = rng16Code.Offset(0, 1) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "A") 0
rng16Code.Offset(0, 2) = rng16Code.Offset(0, 2) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "B") 0
rng16Code.Offset(0, 3) = rng16Code.Offset(0, 3) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "G") 0
rng16Code.Offset(0, 3) = rng16Code.Offset(0, 3) + 1
Case Else
'Do nothing
End Select

HTH,
--
George Nicholson

Remove 'Junk' from return address.

They are mutually exclusive but if you look at the code, you'll see
that B & G are counted together. I was wondering if that would be
possible with a Select Case statement.



"davegb" wrote in message
oups.com...
I have a workbook where our specialists enter their activities by
alphanumeric code. (Some codes alpha, some numeric, none mixed). Each
specialist has 2 sheets in the workbook. One in which they report their
work, another that tallies the work by code and month and creates a
graph for them and others to look for trends, etc. The macro I've
written, with this NG's help, is run when a specialist's monthy tally
sheet is selected. The macro goes to the entry, or source, sheet, and
checks each cell in the specified range for certain codes. If it finds
an appropriate code, it checks another cell to see if it has a
recognizable date. If these criteria are met, it tallies the number of
times a giving code occurs in each month of the year. If the criteria
are not met, it skips to the next cell. One of the codes, 16, has
tallied subcodes as well (A, R, B, G). It all works fine.
I've been writing VBA macros for about 8 months now, and my progress
has been slow. I want to get better at this.
What I'm interested in is how to streamline the code, if possible. How
would someone do the same thing with less code? Speed is not important
in this application, no specialist has more than a 1000 entries. But
what if it were? How would you make this run even faster?
I'm particularly interested in better ways to do the subcodes. I've
marked this part of the macro.
I'd also appreciate feedback on formatting and comments. Any way to
make it easier to come back later and debug or change the code.
Thanks for any feedback.

Sub SpecMonthCount()

Dim lngRsnCode As Long 'Reason Code from source sheet
Dim wksSrc As Worksheet 'source worksheet, where specicalists enter
their counts
Dim wksSpecMon As Worksheet 'Monthly sheet, where the counts are
tallied by month
Dim wksTot As Worksheet 'TOTALS worksheet where the vlookup for tally
column & row is determined
Dim rngCode As Range 'range in which codes are stored
Dim lEndRow As Long 'no of rows to check for values
Dim strMonWksht As String 'current Monthly worksheet name
Dim dteColCode As Date 'date of contact taken from source sheet
Dim lngCntctMo As Long 'month taken from contact date
Dim lngMoRow As Long 'the appropriate row where that months tally is
entered
Dim rngCell As Range 'current cell from which reason code is taken
Dim varColCode As Variant 'date taken from Contact Date field
Dim strColCode As String 'column where current data is tallied
determined by vlookup in TOTALS sheet
Dim lCt As Long 'counter for subcategories of category 16 (CIR's, sub
cat A, B, G, R)
Dim rng16Code As Range 'starting point for entering cat 16 sub cats
Dim strSrc As String 'name of source sheet gotten by extracting from
selected montly sheet
Dim strSpecMon As String 'name of specialist's monthly sheet

Const PWORD As String = "2005totals"
lEndRow = 1000
Set wksSpecMon = ActiveSheet
Set wksTot = ActiveWorkbook.Sheets("TOTALS")
strSpecMon = wksSpecMon.Name

'Get source sheet name from monthly sheet name
strSrc = Left(strSpecMon, Len(strSpecMon) - 10)
Set wksSrc = Sheets(strSrc)

Set rngCode = wksSrc.Range("D8:D" & lEndRow)
wksTot.Unprotect Password:=PWORD

wksSpecMon.Range("B4:K15").ClearContents

For Each rngCell In rngCode

dteColCode = 0

Select Case rngCell
Case 1, 14, 4, 13, 3, 7, 16

Set varColCode = rngCell.Offset(0, 5)

'if there's a comma in the code value, skip to the next cell
If InStr(1, varColCode, ",") = 0 Then

'if the code cell is blank, skip to the next cell
If Trim(varColCode.Value) < "" Then

'if the code is not a date, procede to the next
step
On Error Resume Next
dteColCode = DateValue(varColCode.Value)

'reset error handling to default
On Error GoTo 0

'if the code cell is blank, skip to the next cell
If dteColCode < Empty Then
'extract the month from the date field,
' add 3 to get the row to enter the count in
lngCntctMo = Month(dteColCode)
lngMoRow = lngCntctMo + 3

'enter the reason code into the Totals sheet
' and do a vlookup to get the column to enter the
code in
lngRsnCode = rngCell.Value
wksTot.Range("AC1") = lngRsnCode
strColCode = wksTot.Range("AC2")
wksSpecMon.Cells(lngMoRow, strColCode) = _
wksSpecMon.Cells(lngMoRow, strColCode) + 1

'test if cat 16
If rngCell = "16" Then <---SUBCODE PROCEDURE
START
'determine starting point for cat 16
sub cat tally
Set rng16Code =
wksSpecMon.Cells(lngMoRow, strColCode)
'tally cell if cat R
lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "R")
If lCt 0 Then
rng16Code.Offset(0, 1) = _
rng16Code.Offset(0, 1) + 1

lCt = 0
End If

lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "A")
If lCt 0 Then
rng16Code.Offset(0, 2) = _
rng16Code.Offset(0, 2) + 1
lCt = 0
End If

lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "B")
If lCt 0 Then
rng16Code.Offset(0, 3) = _
rng16Code.Offset(0, 3) + 1
Else
lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "G")
If lCt 0 Then
rng16Code.Offset(0, 3) = _
rng16Code.Offset(0, 3) + 1
lCt = 0
End If

End If <---SUBCODE PROCEDURE ENDS
End If
End If
End If
End If

End Select
Next rngCell

End Sub

They are mutually exclusive but if you look at the code, you'll see
that B & G are counted together. I was wondering if that would be
possible with a Select Case statement.

Your code counts them as follows:
If B then
Increment BG counter
else
If G then
Increment BG counter
end if
end if

You are treating them as mutually exclusive separate entities whose results
share the same counter. The Select Case is doing the same thing.


HTH,
--
George Nicholson

Remove 'Junk' from return address.


"davegb" wrote in message
oups.com...
George,
Thanks for your reply.

George Nicholson wrote:
1) strColCode = wksTot.Range("AC2")
Any variables that can be set before you start your loop, should be.
Otherwise, if you have 1000 cells in your loop you are setting it 999
times
unneccessarily. "A billion here, a billion there. Pretty soon we're
talking
real money..."

In this case, the variable is being determined by a vlookup initiated
by the previous step, and has to be done every time.



2) If A, R, B, G subcodes are mutually exclusive (i.e., any given record
might have one, but only one of those codes) then you might consider the
following structu

Set rng16Code = wksSpecMon.Cells(lngMoRow, strColCode)

Select Case True
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "R") 0
rng16Code.Offset(0, 1) = rng16Code.Offset(0, 1) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "A") 0
rng16Code.Offset(0, 2) = rng16Code.Offset(0, 2) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "B") 0
rng16Code.Offset(0, 3) = rng16Code.Offset(0, 3) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "G") 0
rng16Code.Offset(0, 3) = rng16Code.Offset(0, 3) + 1
Case Else
'Do nothing
End Select

HTH,
--
George Nicholson

Remove 'Junk' from return address.

They are mutually exclusive but if you look at the code, you'll see
that B & G are counted together. I was wondering if that would be
possible with a Select Case statement.



"davegb" wrote in message
oups.com...
I have a workbook where our specialists enter their activities by
alphanumeric code. (Some codes alpha, some numeric, none mixed). Each
specialist has 2 sheets in the workbook. One in which they report their
work, another that tallies the work by code and month and creates a
graph for them and others to look for trends, etc. The macro I've
written, with this NG's help, is run when a specialist's monthy tally
sheet is selected. The macro goes to the entry, or source, sheet, and
checks each cell in the specified range for certain codes. If it finds
an appropriate code, it checks another cell to see if it has a
recognizable date. If these criteria are met, it tallies the number of
times a giving code occurs in each month of the year. If the criteria
are not met, it skips to the next cell. One of the codes, 16, has
tallied subcodes as well (A, R, B, G). It all works fine.
I've been writing VBA macros for about 8 months now, and my progress
has been slow. I want to get better at this.
What I'm interested in is how to streamline the code, if possible. How
would someone do the same thing with less code? Speed is not important
in this application, no specialist has more than a 1000 entries. But
what if it were? How would you make this run even faster?
I'm particularly interested in better ways to do the subcodes. I've
marked this part of the macro.
I'd also appreciate feedback on formatting and comments. Any way to
make it easier to come back later and debug or change the code.
Thanks for any feedback.

Sub SpecMonthCount()

Dim lngRsnCode As Long 'Reason Code from source sheet
Dim wksSrc As Worksheet 'source worksheet, where specicalists enter
their counts
Dim wksSpecMon As Worksheet 'Monthly sheet, where the counts are
tallied by month
Dim wksTot As Worksheet 'TOTALS worksheet where the vlookup for tally
column & row is determined
Dim rngCode As Range 'range in which codes are stored
Dim lEndRow As Long 'no of rows to check for values
Dim strMonWksht As String 'current Monthly worksheet name
Dim dteColCode As Date 'date of contact taken from source sheet
Dim lngCntctMo As Long 'month taken from contact date
Dim lngMoRow As Long 'the appropriate row where that months tally is
entered
Dim rngCell As Range 'current cell from which reason code is taken
Dim varColCode As Variant 'date taken from Contact Date field
Dim strColCode As String 'column where current data is tallied
determined by vlookup in TOTALS sheet
Dim lCt As Long 'counter for subcategories of category 16 (CIR's, sub
cat A, B, G, R)
Dim rng16Code As Range 'starting point for entering cat 16 sub cats
Dim strSrc As String 'name of source sheet gotten by extracting from
selected montly sheet
Dim strSpecMon As String 'name of specialist's monthly sheet

Const PWORD As String = "2005totals"
lEndRow = 1000
Set wksSpecMon = ActiveSheet
Set wksTot = ActiveWorkbook.Sheets("TOTALS")
strSpecMon = wksSpecMon.Name

'Get source sheet name from monthly sheet name
strSrc = Left(strSpecMon, Len(strSpecMon) - 10)
Set wksSrc = Sheets(strSrc)

Set rngCode = wksSrc.Range("D8:D" & lEndRow)
wksTot.Unprotect Password:=PWORD

wksSpecMon.Range("B4:K15").ClearContents

For Each rngCell In rngCode

dteColCode = 0

Select Case rngCell
Case 1, 14, 4, 13, 3, 7, 16

Set varColCode = rngCell.Offset(0, 5)

'if there's a comma in the code value, skip to the next cell
If InStr(1, varColCode, ",") = 0 Then

'if the code cell is blank, skip to the next cell
If Trim(varColCode.Value) < "" Then

'if the code is not a date, procede to the next
step
On Error Resume Next
dteColCode = DateValue(varColCode.Value)

'reset error handling to default
On Error GoTo 0

'if the code cell is blank, skip to the next cell
If dteColCode < Empty Then
'extract the month from the date field,
' add 3 to get the row to enter the count in
lngCntctMo = Month(dteColCode)
lngMoRow = lngCntctMo + 3

'enter the reason code into the Totals sheet
' and do a vlookup to get the column to enter the
code in
lngRsnCode = rngCell.Value
wksTot.Range("AC1") = lngRsnCode
strColCode = wksTot.Range("AC2")
wksSpecMon.Cells(lngMoRow, strColCode) = _
wksSpecMon.Cells(lngMoRow, strColCode) + 1

'test if cat 16
If rngCell = "16" Then <---SUBCODE PROCEDURE
START
'determine starting point for cat 16
sub cat tally
Set rng16Code =
wksSpecMon.Cells(lngMoRow, strColCode)
'tally cell if cat R
lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "R")
If lCt 0 Then
rng16Code.Offset(0, 1) = _
rng16Code.Offset(0, 1) + 1

lCt = 0
End If

lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "A")
If lCt 0 Then
rng16Code.Offset(0, 2) = _
rng16Code.Offset(0, 2) + 1
lCt = 0
End If

lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "B")
If lCt 0 Then
rng16Code.Offset(0, 3) = _
rng16Code.Offset(0, 3) + 1
Else
lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "G")
If lCt 0 Then
rng16Code.Offset(0, 3) = _
rng16Code.Offset(0, 3) + 1
lCt = 0
End If

End If <---SUBCODE PROCEDURE ENDS
End If
End If
End If
End If

End Select
Next rngCell

End Sub

George Nicholson wrote:
They are mutually exclusive but if you look at the code, you'll see
that B & G are counted together. I was wondering if that would be
possible with a Select Case statement.

Your code counts them as follows:
If B then
Increment BG counter
else
If G then
Increment BG counter
end if
end if

You are treating them as mutually exclusive separate entities whose results
share the same counter. The Select Case is doing the same thing.


HTH,
--
George Nicholson

Thanks, George, that's what I wanted.


Remove 'Junk' from return address.


"davegb" wrote in message
oups.com...
George,
Thanks for your reply.

George Nicholson wrote:
1) strColCode = wksTot.Range("AC2")
Any variables that can be set before you start your loop, should be.
Otherwise, if you have 1000 cells in your loop you are setting it 999
times
unneccessarily. "A billion here, a billion there. Pretty soon we're
talking
real money..."

In this case, the variable is being determined by a vlookup initiated
by the previous step, and has to be done every time.



2) If A, R, B, G subcodes are mutually exclusive (i.e., any given record
might have one, but only one of those codes) then you might consider the
following structu

Set rng16Code = wksSpecMon.Cells(lngMoRow, strColCode)

Select Case True
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "R") 0
rng16Code.Offset(0, 1) = rng16Code.Offset(0, 1) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "A") 0
rng16Code.Offset(0, 2) = rng16Code.Offset(0, 2) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "B") 0
rng16Code.Offset(0, 3) = rng16Code.Offset(0, 3) + 1
Case InStr(1, UCase(rngCell.Offset(0, 2).Value), "G") 0
rng16Code.Offset(0, 3) = rng16Code.Offset(0, 3) + 1
Case Else
'Do nothing
End Select

HTH,
--
George Nicholson

Remove 'Junk' from return address.

They are mutually exclusive but if you look at the code, you'll see
that B & G are counted together. I was wondering if that would be
possible with a Select Case statement.



"davegb" wrote in message
oups.com...
I have a workbook where our specialists enter their activities by
alphanumeric code. (Some codes alpha, some numeric, none mixed). Each
specialist has 2 sheets in the workbook. One in which they report their
work, another that tallies the work by code and month and creates a
graph for them and others to look for trends, etc. The macro I've
written, with this NG's help, is run when a specialist's monthy tally
sheet is selected. The macro goes to the entry, or source, sheet, and
checks each cell in the specified range for certain codes. If it finds
an appropriate code, it checks another cell to see if it has a
recognizable date. If these criteria are met, it tallies the number of
times a giving code occurs in each month of the year. If the criteria
are not met, it skips to the next cell. One of the codes, 16, has
tallied subcodes as well (A, R, B, G). It all works fine.
I've been writing VBA macros for about 8 months now, and my progress
has been slow. I want to get better at this.
What I'm interested in is how to streamline the code, if possible. How
would someone do the same thing with less code? Speed is not important
in this application, no specialist has more than a 1000 entries. But
what if it were? How would you make this run even faster?
I'm particularly interested in better ways to do the subcodes. I've
marked this part of the macro.
I'd also appreciate feedback on formatting and comments. Any way to
make it easier to come back later and debug or change the code.
Thanks for any feedback.

Sub SpecMonthCount()

Dim lngRsnCode As Long 'Reason Code from source sheet
Dim wksSrc As Worksheet 'source worksheet, where specicalists enter
their counts
Dim wksSpecMon As Worksheet 'Monthly sheet, where the counts are
tallied by month
Dim wksTot As Worksheet 'TOTALS worksheet where the vlookup for tally
column & row is determined
Dim rngCode As Range 'range in which codes are stored
Dim lEndRow As Long 'no of rows to check for values
Dim strMonWksht As String 'current Monthly worksheet name
Dim dteColCode As Date 'date of contact taken from source sheet
Dim lngCntctMo As Long 'month taken from contact date
Dim lngMoRow As Long 'the appropriate row where that months tally is
entered
Dim rngCell As Range 'current cell from which reason code is taken
Dim varColCode As Variant 'date taken from Contact Date field
Dim strColCode As String 'column where current data is tallied
determined by vlookup in TOTALS sheet
Dim lCt As Long 'counter for subcategories of category 16 (CIR's, sub
cat A, B, G, R)
Dim rng16Code As Range 'starting point for entering cat 16 sub cats
Dim strSrc As String 'name of source sheet gotten by extracting from
selected montly sheet
Dim strSpecMon As String 'name of specialist's monthly sheet

Const PWORD As String = "2005totals"
lEndRow = 1000
Set wksSpecMon = ActiveSheet
Set wksTot = ActiveWorkbook.Sheets("TOTALS")
strSpecMon = wksSpecMon.Name

'Get source sheet name from monthly sheet name
strSrc = Left(strSpecMon, Len(strSpecMon) - 10)
Set wksSrc = Sheets(strSrc)

Set rngCode = wksSrc.Range("D8:D" & lEndRow)
wksTot.Unprotect Password:=PWORD

wksSpecMon.Range("B4:K15").ClearContents

For Each rngCell In rngCode

dteColCode = 0

Select Case rngCell
Case 1, 14, 4, 13, 3, 7, 16

Set varColCode = rngCell.Offset(0, 5)

'if there's a comma in the code value, skip to the next cell
If InStr(1, varColCode, ",") = 0 Then

'if the code cell is blank, skip to the next cell
If Trim(varColCode.Value) < "" Then

'if the code is not a date, procede to the next
step
On Error Resume Next
dteColCode = DateValue(varColCode.Value)

'reset error handling to default
On Error GoTo 0

'if the code cell is blank, skip to the next cell
If dteColCode < Empty Then
'extract the month from the date field,
' add 3 to get the row to enter the count in
lngCntctMo = Month(dteColCode)
lngMoRow = lngCntctMo + 3

'enter the reason code into the Totals sheet
' and do a vlookup to get the column to enter the
code in
lngRsnCode = rngCell.Value
wksTot.Range("AC1") = lngRsnCode
strColCode = wksTot.Range("AC2")
wksSpecMon.Cells(lngMoRow, strColCode) = _
wksSpecMon.Cells(lngMoRow, strColCode) + 1

'test if cat 16
If rngCell = "16" Then <---SUBCODE PROCEDURE
START
'determine starting point for cat 16
sub cat tally
Set rng16Code =
wksSpecMon.Cells(lngMoRow, strColCode)
'tally cell if cat R
lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "R")
If lCt 0 Then
rng16Code.Offset(0, 1) = _
rng16Code.Offset(0, 1) + 1

lCt = 0
End If

lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "A")
If lCt 0 Then
rng16Code.Offset(0, 2) = _
rng16Code.Offset(0, 2) + 1
lCt = 0
End If

lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "B")
If lCt 0 Then
rng16Code.Offset(0, 3) = _
rng16Code.Offset(0, 3) + 1
Else
lCt = InStr(1, UCase(rngCell.Offset(0,
2).Value), "G")
If lCt 0 Then
rng16Code.Offset(0, 3) = _
rng16Code.Offset(0, 3) + 1
lCt = 0
End If

End If <---SUBCODE PROCEDURE ENDS
End If
End If
End If
End If

End Select
Next rngCell

End Sub