D
davegb
I have a macro that scans a column of values looking for specific
numeric codes, i.e. 1, 7, 14, etc. It goes to a vlookup to determine
where to put a counter for that code. It works great for that. Problem
is, occasionally, someone has entered multiple codes in the cell, like
"7,14". I'd like the code to count the 7 and the 14 separately and do
the steps it normally does for a single value for each of the values.
Here's the code so far:
Sub CountMonth()
Dim lngRsnCode As Long
Dim wksSrc As Worksheet
Dim wksMon As Worksheet
Dim wksTot As Worksheet
Dim rngCode As Range
Dim lEndRow As Long
Dim strMonWksht As String
Dim dteColCode As Date
Dim lngCntctMo As Long
Dim lngMoRow As Long
Dim strColCode As String
Dim rngCell As Range
Const PWORD As String = "2005totals"
lEndRow = 1000
Set wksSrc = ActiveSheet '("Barry S")
Set wksTot = ActiveWorkbook.Sheets("TOTALS")
Set rngCode = wksSrc.Range("D8" & lEndRow)
wksTot.Unprotect Password:=PWORD
strMonWksht = wksSrc.Name & " - Monthly"
Set wksMon = Sheets(strMonWksht)
wksMon.Range("B4:K15").ClearContents
For Each rngCell In rngCode
If rngCell <> 0 Then
If rngCell <> 11 Then
If rngCell <> 15 Then
On Error Resume Next
dteColCode = rngCell.Offset(0, 5)
lngCntctMo = Month(dteColCode)
lngMoRow = lngCntctMo + 3
lngRsnCode = rngCell
wksTot.Range("AC1") = lngRsnCode
strColCode = wksTot.Range("AC2")
wksMon.Cells(lngMoRow, strColCode) = _
wksMon.Cells(lngMoRow, strColCode) + 1
End If
End If
End If
Next rngCell
wksTot.Protect Password:=PWORD
wksTot.Select
End Sub
numeric codes, i.e. 1, 7, 14, etc. It goes to a vlookup to determine
where to put a counter for that code. It works great for that. Problem
is, occasionally, someone has entered multiple codes in the cell, like
"7,14". I'd like the code to count the 7 and the 14 separately and do
the steps it normally does for a single value for each of the values.
Here's the code so far:
Sub CountMonth()
Dim lngRsnCode As Long
Dim wksSrc As Worksheet
Dim wksMon As Worksheet
Dim wksTot As Worksheet
Dim rngCode As Range
Dim lEndRow As Long
Dim strMonWksht As String
Dim dteColCode As Date
Dim lngCntctMo As Long
Dim lngMoRow As Long
Dim strColCode As String
Dim rngCell As Range
Const PWORD As String = "2005totals"
lEndRow = 1000
Set wksSrc = ActiveSheet '("Barry S")
Set wksTot = ActiveWorkbook.Sheets("TOTALS")
Set rngCode = wksSrc.Range("D8" & lEndRow)
wksTot.Unprotect Password:=PWORD
strMonWksht = wksSrc.Name & " - Monthly"
Set wksMon = Sheets(strMonWksht)
wksMon.Range("B4:K15").ClearContents
For Each rngCell In rngCode
If rngCell <> 0 Then
If rngCell <> 11 Then
If rngCell <> 15 Then
On Error Resume Next
dteColCode = rngCell.Offset(0, 5)
lngCntctMo = Month(dteColCode)
lngMoRow = lngCntctMo + 3
lngRsnCode = rngCell
wksTot.Range("AC1") = lngRsnCode
strColCode = wksTot.Range("AC2")
wksMon.Cells(lngMoRow, strColCode) = _
wksMon.Cells(lngMoRow, strColCode) + 1
End If
End If
End If
Next rngCell
wksTot.Protect Password:=PWORD
wksTot.Select
End Sub