Articles

tweaked code working incorrectly

August 24, 2010 at 01:48:09
Specs: Windows XP

A very helpful individual wrote this code for me, and I seem to be having some difficulty tweaking it very slightly. Basically, it is for a calendar in excel, departments in column A, then across B1, C1 etc are months. Across B2 etc etc is 1,2,3,4,5 representing the weeks (this is sheet1). In Sheet2, we have 5 columns; Name, School, Department (corresponds to column A in sheet1), month (corresponds to the selected month) and week (1-5). When I enter a name, select a school from a dropdown, select a month from a dropdown then select a week, in the relevant cell of that dept under the relevant week/month, a comment will appear with the name and school in it, and a number in the cell to count how many comments there are (the counting is fine).

Originally the code was written for just up to 4 weeks, but of course there are 5 weeks in some months. I tweaked the code slightly, to allow it to operate on up to 5 months, but the difficulty is, the code no longer recognises week 1 for any 5 week month when selected. For example, if I select August week 5, the comment will appear in Sept week 1, totally skipping the month. I include the code below for your info. any help greatly appreciated.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim theWeek, theMonth, theDept, oldText As String
Dim m, w, d As Range
Dim numChar, lenComment, numLines As Integer
On Error Resume Next
'Was Changed Made to Column 4 (D)?
If Target.Column = 5 Then
Application.EnableEvents = False
'Make sure a Dept and Month have been selected
If Target.Offset(0, -1) = "" Or Target.Offset(0, -2) = "" Then
Target = ""
MsgBox "You must select a Department and Month first"
GoTo done
End If
'If All is OK, grab Dept, Month & Week
theWeek = Target.Value
theMonth = Target.Offset(0, -1)
theDept = Target.Offset(0, -2)
'Find Month in Sheet 1, Row 1 to use as Address for Week
With Sheets(1).Rows(1)
Set m = .Find(theMonth, _
lookat:=xlWhole, LookIn:=xlValues)
End With
'Find Week for that Month to use as Column for Comment
With Sheets(1).Range(Sheets(1).Cells(2, m.Column), _
Sheets(1).Cells(2, m.Column + 5))
Set w = .Find(theWeek, _
lookat:=xlWhole, LookIn:=xlValues)
End With
'Find Department to use as Row for Comment
With Sheets(1).Columns(1)
Set d = .Find(theDept, _
lookat:=xlWhole, LookIn:=xlValues)
End With
'Add comment to cell on Sheet1 using data from Sheet2
Sheets(1).Cells(d.Row, w.Column).AddComment
If Sheets(1).Cells(d.Row, w.Column).Comment.Text <> "" Then
oldText = Sheets(1).Cells(d.Row, w.Column).Comment.Text & vbLf
End If
Sheets(1).Cells(d.Row, w.Column).Comment.Text _
Text:=oldText & Sheets(2).Cells(Target.Row, 1).Value & "-" & Sheets(2).Cells(Target.Row, 2).Value
''Count lines in comment
'Find length of Comment text
lenComment = Len(Sheets(1).Cells(d.Row, w.Column).Comment.Text)
'Loop through Comment Text characters looking for Line Feeds
'Increment numLines variable when each Line Feed is found
For numChar = 1 To lenComment
If Mid(Sheets(1).Cells(d.Row, w.Column).Comment.Text, numChar, 1) _
= vbLf Then
numLines = numLines + 1
End If
'Put number of lines in cell, with no Line Feeds, there is 1 line
Sheets(1).Cells(d.Row, w.Column).Value = numLines + 1
Next
End If
done:
Application.EnableEvents = True
End Sub

Sub CountLines()
Dim numChar, numLines, lenComment As Integer
Dim cel As Range
For Each cel In Sheets(1).Range("B3:AW57")
On Error Resume Next
lenComment = Len(cel.Comment.Text)
For numChar = 1 To lenComment
If Mid(cel.Comment.Text, numChar, 1) = vbLf Then
numLines = numLines + 1
End If
cel.Value = numLines + 1
Next
lenComment = 0
numLines = 0
Next
End Sub



See More: tweaked code working incorrectly

Report •


#1
August 24, 2010 at 04:35:50

Please repost the code inside the pre tags to make it easier for us to read.

You will notice that in the VBA editor the code uses indents to separate the sections.

Copy the code from the VBA editor, click the symbol that says pre above the Post Reply box and paste the code between the > and <. This should retain the indentation format.


Report •

#2
August 24, 2010 at 04:44:46

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim theWeek, theMonth, theDept, oldText As String
Dim m, w, d As Range
Dim numChar, lenComment, numLines As Integer
On Error Resume Next
'Was Changed Made to Column 4 (D)?
If Target.Column = 5 Then
Application.EnableEvents = False
'Make sure a Dept and Month have been selected
If Target.Offset(0, -1) = "" Or Target.Offset(0, -2) = "" Then
Target = ""
MsgBox "You must select a Department and Month first"
GoTo done
End If
'If All is OK, grab Dept, Month & Week
theWeek = Target.Value
theMonth = Target.Offset(0, -1)
theDept = Target.Offset(0, -2)
'Find Month in Sheet 1, Row 1 to use as Address for Week
With Sheets(1).Rows(1)
Set m = .Find(theMonth, _
lookat:=xlWhole, LookIn:=xlValues)
End With
'Find Week for that Month to use as Column for Comment
With Sheets(1).Range(Sheets(1).Cells(2, m.Column), _
Sheets(1).Cells(2, m.Column + 5))
Set w = .Find(theWeek, _
lookat:=xlWhole, LookIn:=xlValues)
End With
'Find Department to use as Row for Comment
With Sheets(1).Columns(1)
Set d = .Find(theDept, _
lookat:=xlWhole, LookIn:=xlValues)
End With
'Add comment to cell on Sheet1 using data from Sheet2
Sheets(1).Cells(d.Row, w.Column).AddComment
If Sheets(1).Cells(d.Row, w.Column).Comment.Text <> "" Then
oldText = Sheets(1).Cells(d.Row, w.Column).Comment.Text & vbLf
End If
Sheets(1).Cells(d.Row, w.Column).Comment.Text _
Text:=oldText & Sheets(2).Cells(Target.Row, 1).Value & "-" & Sheets(2).Cells(Target.Row, 2).Value
''Count lines in comment
'Find length of Comment text
lenComment = Len(Sheets(1).Cells(d.Row, w.Column).Comment.Text)
'Loop through Comment Text characters looking for Line Feeds
'Increment numLines variable when each Line Feed is found
For numChar = 1 To lenComment
If Mid(Sheets(1).Cells(d.Row, w.Column).Comment.Text, numChar, 1) _
= vbLf Then
numLines = numLines + 1
End If
'Put number of lines in cell, with no Line Feeds, there is 1 line
Sheets(1).Cells(d.Row, w.Column).Value = numLines + 1
Next
End If
done:
Application.EnableEvents = True
End Sub

Sub CountLines()
Dim numChar, numLines, lenComment As Integer
Dim cel As Range
For Each cel In Sheets(1).Range("B3:AW57")
On Error Resume Next
lenComment = Len(cel.Comment.Text)
For numChar = 1 To lenComment
If Mid(cel.Comment.Text, numChar, 1) = vbLf Then
numLines = numLines + 1
End If
cel.Value = numLines + 1
Next
lenComment = 0
numLines = 0
Next
End Sub


Report •

#3
August 24, 2010 at 07:22:59

Hi,

Put your data between <pre> and </pre> tags that you can insert using the 'pre' icon above the reply box.

Then use the 'Preview Follow Up' button to see if all is OK - if not, edit as required. To preview again, check the 'Check To Show Confirmation Page Again' box and click 'Confirm and see post'

Regards


Report •

Related Solutions

#4
August 24, 2010 at 08:47:20

I've done that.

Report •

#5
August 24, 2010 at 10:38:10

Did you copy the code from your post or did you copy it from the VBA editor?

If you copied it from the VBA editor, is it left-justified in the VBA editor like it appears to be in both of your posts?

If it is indented in the VBA editor, then it should stay indented when used with the pre tags.


Report •

#6
August 24, 2010 at 12:33:58

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim theWeek, theMonth, theDept, oldText As String
Dim m, w, d As Range
Dim numChar, lenComment, numLines As Integer
On Error Resume Next
'Was Changed Made to Column 4 (D)?
 If Target.Column = 5 Then
  Application.EnableEvents = False
'Make sure a Dept and Month have been selected
   If Target.Offset(0, -1) = "" Or Target.Offset(0, -2) = "" Then
     Target = ""
     MsgBox "You must select a Department and Month first"
     GoTo done
   End If
'If All is OK, grab Dept, Month & Week
   theWeek = Target.Value
   theMonth = Target.Offset(0, -1)
   theDept = Target.Offset(0, -2)
'Find Month in Sheet 1, Row 1 to use as Address for Week
  With Sheets(1).Rows(1)
     Set m = .Find(theMonth, _
               lookat:=xlWhole, LookIn:=xlValues)
  End With
'Find Week for that Month to use as Column for Comment
  With Sheets(1).Range(Sheets(1).Cells(2, m.Column), _
                       Sheets(1).Cells(2, m.Column + 5))
     Set w = .Find(theWeek, _
               lookat:=xlWhole, LookIn:=xlValues)
  End With
'Find Department to use as Row for Comment
  With Sheets(1).Columns(1)
     Set d = .Find(theDept, _
               lookat:=xlWhole, LookIn:=xlValues)
  End With
'Add comment to cell on Sheet1 using data from Sheet2
     Sheets(1).Cells(d.Row, w.Column).AddComment
      If Sheets(1).Cells(d.Row, w.Column).Comment.Text <> "" Then
       oldText = Sheets(1).Cells(d.Row, w.Column).Comment.Text & vbLf
      End If
       Sheets(1).Cells(d.Row, w.Column).Comment.Text _
            Text:=oldText & Sheets(2).Cells(Target.Row, 1).Value & "-" & Sheets(2).Cells(Target.Row, 2).Value
''Count lines in comment
'Find length of Comment text
        lenComment = Len(Sheets(1).Cells(d.Row, w.Column).Comment.Text)
'Loop through Comment Text characters looking for Line Feeds
'Increment numLines variable when each Line Feed is found
         For numChar = 1 To lenComment
          If Mid(Sheets(1).Cells(d.Row, w.Column).Comment.Text, numChar, 1) _
             = vbLf Then
             numLines = numLines + 1
          End If
'Put number of lines in cell, with no Line Feeds, there is 1 line
          Sheets(1).Cells(d.Row, w.Column).Value = numLines + 1
        Next
 End If
done:
 Application.EnableEvents = True
End Sub

Sub CountLines()
 Dim numChar, numLines, lenComment As Integer
 Dim cel As Range
  For Each cel In Sheets(1).Range("B3:AW57")
   On Error Resume Next
    lenComment = Len(cel.Comment.Text)
     For numChar = 1 To lenComment
      If Mid(cel.Comment.Text, numChar, 1) = vbLf Then
       numLines = numLines + 1
      End If
       cel.Value = numLines + 1
     Next
   lenComment = 0
   numLines = 0
  Next
End Sub







Report •

#7
August 24, 2010 at 13:09:51

Hopefully I still have the workbook with the orginal code on my system at home.

If I do, I'll see what I can do.

However, I'm a bit confused by what you are considering a "week".

If I look at a standard 2010 calendar, every month has at least 1 day in each of 5 "weeks". Some have have 1 or more days in 6 "weeks".

For example, one could consider May 1 to be in the first week of May, but that's the same week as April 30, which could be considered the 5th week of April.

What are you using to determine what date is in what week?

(Of course, this all may become clear once I find the original workbook.)


Report •

#8
August 24, 2010 at 14:15:21

Hi Derby,
Many thanks again. Take this month for example, the 30th and 31st are in my working calendar, the fifth week, eventhough they are only the Mon/Tues of a week that also includes the 1st week of Sept, but I intend that any month that has dates at all going into a fifth week be available to select, I will be checking before adding anything to a calendar of the relevant week.

Report •

#9
August 24, 2010 at 15:53:32

It appears that you have made changes to both your spreadsheet and your code. The original code checked for a changes in Column 4 (D) but it now appears that you are checking for changes to column 5 (E).

'Was Changed Made to Column 4 (D)?
  If Target.Column = 5 Then

You changed the code, but you didn't change the comment, which confused me at first and may end up confusing you later. You should make sure you change the comments so that any one who looks at the code (including yourself) will understand what is going on.

'Was Changed Made to Column 5 (E)?
  If Target.Column = 5 Then

Here's one way to solve your current problem, which is based on the latest workbook I sent you via email a few weeks ago (example_v4.xls) If you have moved columns around then you'll have to adjust my steps to match what you now have.

1 - Add a column for a 5th week to every month on Sheet 1.
2 - For any month that should only have 4 weeks, hide the 5th week column.
3 - For those months that have 5 weeks, re-center the Month name across the 5 columns.

The next few steps are going to be used to set up the Validation Lists for the Week Drop Downs. There maybe other ways to do this, but the main goal is to only allow "5" to be chosen for those months that actually have 5 weeks.

4 - On Sheet 3, locate the list of months (B1:B12)
5 - In Columns C through F or G, depending on how many weeks are in a given month, enter either 1 though 4 or 1 through 5

e.g.:

         B     C    D    E    F    G   
1    January   1    2    3    4    5
2    February  1    2    3    4    

Based on the example above...

6 - Select B1:G1
7 - Use Insert...Name...Create...
8 - In the "Create Names" dialog box, make sure only Left Column is checked.
9 - Repeat this for each month, selecting either Cx:Fx or Cx:Gx depending on whether you have 4 weeks or 5.

What you have done is create a Named Range for each month, with each range containing the correct number of weeks for that month. We will use these named ranges in the next 2 steps.

10 - On Sheet 2, select all of the cells in which you want to place the Week Drop Downs.
11 - Use Data Validation...List with this formula:

=INDIRECT(C2) Assuming your first drop down is in Row 2.

What this will do is use the Month name in Column C as the Range Name to populate the Drop Down for the Week Selection Drop Downs. This will allow the user to only choose 1 - 4 for the months that have 4 weeks and 1 - 5 for the months that have 5.

12 - In VBA editor, change the line in the code that looks for the Week to read as follows:

'Find Week for that Month to use as Column for Comment
  With Sheets(1).Range(Sheets(1).Cells(2, m.Column), _
                       Sheets(1).Cells(2, m.Column + 4))

What this does is now search 5 columns (m.Column through m.Column + 4) for the Week that was chosen in the drop down instead of 4. (m.Column through m.Column + 3) Since the user couldn't have chosen Week 5 for months that only have 4 weeks, the code will never find Week 5 for those months.

The point of adding the 5th week to every month was to allow that single line to find the correct week regardless of which month was chosen. If you don't want to add the 5th week column to every month, then we'll need to add code to actually check which month was chosen and and search for the Week within a 4 column range for some months and a 5 column range for the others.

The fact that some months have 4 weeks and some have 5 has to be dealt with someplace, either in the spreadsheet or in the code. I choose to make believe every month has 5 weeks, but only allow the user to choose weeks that actually exist in a given month. That way I don't have to be concerned within the VBA code which month was chosen and I use one segment of code to find the correct week in any month.



Report •


Ask Question