Advice on multiple macros, same code just a different column

  • Thread starter Thread starter L. Howard
  • Start date Start date
L

L. Howard

This is two of seven macros I am writing to do the exact same thing to seven different columns, G to M.

The greatest difference between them is the column B source for the comments text values, which are in blocks of seven rows on sheet "Comments". (A number in column B is the key to grab the Offset(,1) for the comment text back to sheet "Application" and the proper column & cell.

I have intended to run all seven from a single button using an Input box and a Select Case scenario. Input the column letter and call the proper macro. (the OP sent me a workbook with seven buttons, one at the top of each column thinking that is how it has to be)

I suppose a pro could write a single macro that would take the column letter input and do what I am doing with seven. I am not opposed to that but I feel I need to be able to at least read and understand enough of the code to make adjustments and explain it to a moderate degree.

Your thoughts, please. Should I stay with the Select Case, which I know I can do?

Thanks,
Howard

Sub MyCommentMakerG()
Dim c As Range, i As Range
Dim lrg As Long
Dim Grng As Range, GrngC As Range

lrg = Sheets("Application").Cells(Rows.Count, 7).End(xlUp).Row
Set Grng = Sheets("Application").Range("G6:G" & lrg)

Set GrngC = Sheets("Comments").Range("B2:B8")

For Each c In Grng
'MsgBox c.Value
For Each i In GrngC
If i = c Then
c.ClearComments
c.AddComment
c.Comment.Visible = False
c.Comment.Text Text:=i.Offset(, 1).Text
End If
Next
Next

End Sub


Sub MyCommentMakerH()
Dim c As Range, i As Range
Dim lrh As Long
Dim Hrng As Range, HrngC As Range

lrh = Sheets("Application").Cells(Rows.Count, 8).End(xlUp).Row
Set Hrng = Sheets("Application").Range("H6:H" & lrh)

Set HrngC = Sheets("Comments").Range("B9:B15")

For Each c In Hrng
'MsgBox c.Value
For Each i In HrngC
If i = c Then
c.ClearComments
c.AddComment
c.Comment.Visible = False
c.Comment.Text Text:=i.Offset(, 1).Text
End If
Next
Next

End Sub
 
Hi Howard,

Am Fri, 14 Feb 2014 08:55:13 -0800 (PST) schrieb L. Howard:
This is two of seven macros I am writing to do the exact same thing to seven different columns, G to M.

The greatest difference between them is the column B source for the comments text values, which are in blocks of seven rows on sheet "Comments". (A number in column B is the key to grab the Offset(,1) for the comment text back to sheet "Application" and the proper column & cell.

I have intended to run all seven from a single button using an Input box and a Select Case scenario. Input the column letter and call the proper macro. (the OP sent me a workbook with seven buttons, one at the top of each column thinking that is how it has to be)

I suppose a pro could write a single macro that would take the column letter input and do what I am doing with seven. I am not opposed to that but I feel I need to be able to at least read and understand enough of the code to make adjustments and explain it to a moderate degree.
Click to expand...

try:

Sub Test()
Dim rngC As Range, c As Range
Dim AppRng As Range, ComRng As Range
Dim Start As Long
Dim MyCol As String

MyCol = Application.InputBox("Please enter a column character", _
"Column check", Type:=2)

If MyCol = "" Or MyCol = "False" Then Exit Sub

Select Case MyCol
Case "G"
Start = 2
Case "H"
Start = 9
Case "I"
Start = 16
Case "J"
Start = 23
Case "K"
Start = 30
Case "L"
Start = 37
Case "M"
Start = 44
End Select

With Sheets("Comments")
Set ComRng = .Range(.Cells(Start, 2), .Cells(Start + 6, 2))
End With

With Sheets("Application")
Set AppRng = .Range(.Cells(6, MyCol), _
.Cells(.Rows.Count, MyCol).End(xlUp))
End With

For Each rngC In AppRng
For Each c In ComRng
If c = rngC Then
rngC.ClearComments
rngC.AddComment c.Offset(, 1).Text
End If
Next
Next

End Sub


Regards
Claus B.
 
Hi Howard,

Am Fri, 14 Feb 2014 18:37:14 +0100 schrieb Claus Busch:
try:

Sub Test()
Click to expand...

or without Select case:

Sub Test2()
Dim rngC As Range, c As Range
Dim AppRng As Range, ComRng As Range
Dim Start As Long, i As Long
Dim MyCol As String

MyCol = Application.InputBox("Please enter a column character", _
"Column check", Type:=2)

If MyCol = "" Or MyCol = "False" Then Exit Sub

Start = Asc(MyCol) - 69 - (71 - Asc(MyCol)) * 6

With Sheets("Comments")
Set ComRng = .Range(.Cells(Start, 2), .Cells(Start + 6, 2))
End With

With Sheets("Application")
Set AppRng = .Range(.Cells(6, MyCol), _
.Cells(.Rows.Count, MyCol).End(xlUp))
End With

For Each rngC In AppRng
For Each c In ComRng
If c = rngC Then
rngC.ClearComments
rngC.AddComment c.Offset(, 1).Text
End If
Next
Next

End Sub


Regards
Claus B.
 
Hi again,

Am Fri, 14 Feb 2014 19:01:08 +0100 schrieb Claus Busch:
MyCol = Application.InputBox("Please enter a column character", _
"Column check", Type:=2)

If MyCol = "" Or MyCol = "False" Then Exit Sub

Start = Asc(MyCol) - 69 - (71 - Asc(MyCol)) * 6
Click to expand...

check MyCol for the expected range (G:M):

If MyCol = "" Or MyCol = "False" Then Exit Sub
If Asc(MyCol) < 71 Or Asc(MyCol) > 77 Then Exit Sub

Start = Asc(MyCol) - 69 - (71 - Asc(MyCol)) * 6


Regards
Claus B.
 
Hi again,



Am Fri, 14 Feb 2014 19:01:08 +0100 schrieb Claus Busch:







check MyCol for the expected range (G:M):



If MyCol = "" Or MyCol = "False" Then Exit Sub

If Asc(MyCol) < 71 Or Asc(MyCol) > 77 Then Exit Sub



Start = Asc(MyCol) - 69 - (71 - Asc(MyCol)) * 6





Regards

Claus B.

--
Click to expand...


Whoa...! This looks like a lot of good stuff.

I'll set about putting it to work as best I can.

Meanwhile I'm informed that instead of G to M (7mo.s) it is now the entire school year which is 9mo.s cols E to M. That shouldn't be an obstacle.

I am a bit worried abut where the comment text's will come from. That seems to have evolved also, but I'll see if I can make the changes from the code you offered up.

Thanks Claus, I like the Select Case best at this time. Will have to get my feet wet and evaluate both codes.

Thanks, again.

Howard
 
The scenario change a bit on me so I had to make some adjustments and I'm hung up on the first Select Case.

Three sheets will have comments added to them. They are named:
Evaluation
Application
Analysis

Col E to M rows 6 to 23 are the ranges where the comments will go.
A comment is added if the cell has a "Mark" which is a number 0 to 10, if blank then no comment.

Each of those sheets have a sheet that houses the comment text. They are named:
EvalComment
ApplicationComment
AnalysisComment

Column A row 3 to 13 is a list of all the Marks (0 to 10).
Columns B to J row 3 to 13 house the comment text.
So column B on these sheets will be comment text for column E of the other sheet and column J would be the comments for column M on the other sheets.
I am using (MyCol - 3) in the offset to align the columns/text

I'm hung up on getting the EV, AP & AN to the With statement as a proper sheet name well as the comment text sheets to its With statement as a proper sheet name.

Thanks.
Howard


Sub Test()
Dim rngC As Range, c As Range
Dim AppRng As Range, ComRng As Range

Dim MySht As String
Dim myShtComm As String
Dim myShtEAA As String
Dim Start As Long
Dim MyCol As String
Dim EV As String, AP As String, AN As String
Dim Markrng As Range

MySht = Application.InputBox("Please enter a Sheet Nsme" & vbCr & vbCr & _
" EV for Evaluation" & vbCr & vbCr & _
" AP for Application" & vbCr & vbCr & _
" AN for Analysis" & vbCr & " ", _
"Sheet check", Type:=2)
If MySht = "" Or MySht = "False" Then Exit Sub

MyCol = Application.InputBox("Please enter a column character E to M", _
"Column check", Type:=2)

If MyCol = "" Or MyCol = "False" Then Exit Sub
'Add check column is > 4 and < 14

Select Case MySht
Case Is = EV
myShtEAA = "Evaluation"
myShtComm = "EvalComment"

Case Is = AP
myShtEAA = "Application"
myShtComm = "ApplicationComment"

Case Is = AN
myShtEAA = "Analysis"
myShtComm = "AnalysisComment"

End Select

Select Case MyCol

Case "E"
MyCol = 5
Case "F"
MyCol = 6
Case "G"
MyCol = 7
Case "H"
MyCol = 8
Case "I"
MyCol = 9
Case "J"
MyCol = 10
Case "K"
MyCol = 11
Case "L"
MyCol = 12
Case "M"
MyCol = 13
Case Else

End Select
With Sheets(myShtComm)
'With Sheets("comment sheet that MATCHES the selected sheet from input box")
'EvalComment or ApplicationComment or AnalysisComment

Set ComRng = .Range(.Cells(3, 1), .Cells(13, 1))
'Range("A3:A13") for two sheets and sheet ApplicationComment only goes to row 9 but 13 is okay

End With

With Sheets(myShtEAA)

'Evaluation or Application or Analysis (row 6 to 23, col n)
Set Markrng = Range(.Cells(6, MyCol), .Cells(23, MyCol))

End With

For Each rngC In Markrng
For Each c In ComRng
If c = rngC Then
rngC.ClearComments
rngC.AddComment c.Offset(, MyCol - 3).Text
End If
Next
Next

End Sub
 
Hi Howard,

Am Fri, 14 Feb 2014 23:18:17 -0800 (PST) schrieb L. Howard:
Three sheets will have comments added to them. They are named:
Evaluation
Application
Analysis
Click to expand...

please test this code:

Sub Test()
Dim rngC As Range, c As Range
Dim AppRng As Range, ComRng As Range

Dim MySht As String
Dim myShtComm As String
Dim myShtEAA As String
Dim valCol As Long, comCol As Long
Dim MyCol As String
Dim EV As String, AP As String, AN As String
Dim Markrng As Range

MySht = Application.InputBox("Please enter a Sheet Nsme" & vbCr & vbCr &
_
" EV for Evaluation" & vbCr & vbCr & _
" AP for Application" & vbCr & vbCr &
_
" AN for Analysis" & vbCr & " ", _
"Sheet check", Type:=2)
If MySht = "" Or MySht = "False" Then Exit Sub

MyCol = Application.InputBox("Please enter a column character E to M", _
"Column check", Type:=2)

If MyCol = "" Or MyCol = "False" Then Exit Sub
If Asc(MyCol) < 69 Or Asc(MyCol) > 77 Then Exit Sub

Select Case MySht
Case Is = "EV"
myShtEAA = "Evaluation"
myShtComm = "EvalComment"

Case Is = "AP"
myShtEAA = "Application"
myShtComm = "ApplicationComment"

Case Is = "AN"
myShtEAA = "Analysis"
myShtComm = "AnalysisComment"

End Select

'Column with data
valCol = Asc(MyCol) - 64
'Column with comment text
comCol = Asc(MyCol) - 68

With Sheets(myShtComm)
'With Sheets("comment sheet that MATCHES the selected sheet from input
box")
'EvalComment or ApplicationComment or AnalysisComment

Set ComRng = .Range(.Cells(3, 1), .Cells(13, 1))
'Range("A3:A13") for two sheets and sheet ApplicationComment only
goes to row 9 but 13 is okay

End With

With Sheets(myShtEAA)

'Evaluation or Application or Analysis (row 6 to 23, col n)
Set Markrng = .Range(.Cells(6, valCol), .Cells(23, valCol))

End With

For Each rngC In Markrng
For Each c In ComRng
If c = rngC Then
rngC.ClearComments
rngC.AddComment c.Offset(, comCol).Text
End If
Next
Next

End Sub


Regards
Claus B.
 
Hi Howard,

Am Sat, 15 Feb 2014 09:15:52 +0100 schrieb Claus Busch:
please test this code:
Click to expand...

a little bit easier. The values 0 to 10 will be checked without looping
through column A of the comment sheet:

Sub Test()
Dim rngC As Range, c As Range
Dim AppRng As Range, ComRng As Range

Dim MySht As String
Dim myShtComm As String
Dim myShtEAA As String
Dim valCol As Long, comCol As Long
Dim MyCol As String
Dim EV As String, AP As String, AN As String
Dim Markrng As Range

MySht = Application.InputBox("Please enter a Sheet Nsme" & vbCr & vbCr &
_
" EV for Evaluation" & vbCr & vbCr & _
" AP for Application" & vbCr & vbCr &
_
" AN for Analysis" & vbCr & " ", _
"Sheet check", Type:=2)
If MySht = "" Or MySht = "False" Then Exit Sub

MyCol = Application.InputBox("Please enter a column character E to M", _
"Column check", Type:=2)

If MyCol = "" Or MyCol = "False" Then Exit Sub
If Asc(MyCol) < 69 Or Asc(MyCol) > 77 Then Exit Sub

Select Case MySht
Case Is = "EV"
myShtEAA = "Evaluation"
myShtComm = "EvalComment"

Case Is = "AP"
myShtEAA = "Application"
myShtComm = "ApplicationComment"

Case Is = "AN"
myShtEAA = "Analysis"
myShtComm = "AnalysisComment"

End Select

'Column with data
valCol = Asc(MyCol) - 64
'Column with comment text
comCol = Asc(MyCol) - 67

With Sheets(myShtComm)
'With Sheets("comment sheet that MATCHES the selected sheet from input
box")
'EvalComment or ApplicationComment or AnalysisComment

Set ComRng = .Range(.Cells(3, 1), .Cells(13, 1))
'Range("A3:A13") for two sheets and sheet ApplicationComment only
goes to row 9 but 13 is okay

End With

With Sheets(myShtEAA)

'Evaluation or Application or Analysis (row 6 to 23, col n)
Set Markrng = .Range(.Cells(6, valCol), .Cells(23, valCol))

End With

For Each rngC In Markrng
If Not IsEmpty(rngC) And rngC >= 0 And rngC <= 10 Then
rngC.ClearComments
rngC.AddComment Sheets(myShtComm).Cells(rngC + 3, comCol).Text
End If
Next

End Sub


Regards
Claus B.
 
Hi Howard,



Am Sat, 15 Feb 2014 09:15:52 +0100 schrieb Claus Busch:






a little bit easier. The values 0 to 10 will be checked without looping

through column A of the comment sheet:



Sub Test()

Dim rngC As Range, c As Range

Dim AppRng As Range, ComRng As Range



Dim MySht As String

Dim myShtComm As String

Dim myShtEAA As String

Dim valCol As Long, comCol As Long

Dim MyCol As String

Dim EV As String, AP As String, AN As String

Dim Markrng As Range



MySht = Application.InputBox("Please enter a Sheet Nsme" & vbCr & vbCr &

_

" EV for Evaluation" & vbCr & vbCr & _

" AP for Application" & vbCr & vbCr &

_

" AN for Analysis" & vbCr & " ", _

"Sheet check", Type:=2)

If MySht = "" Or MySht = "False" Then Exit Sub



MyCol = Application.InputBox("Please enter a column character E to M", _

"Column check", Type:=2)



If MyCol = "" Or MyCol = "False" Then Exit Sub

If Asc(MyCol) < 69 Or Asc(MyCol) > 77 Then Exit Sub



Select Case MySht

Case Is = "EV"

myShtEAA = "Evaluation"

myShtComm = "EvalComment"



Case Is = "AP"

myShtEAA = "Application"

myShtComm = "ApplicationComment"



Case Is = "AN"

myShtEAA = "Analysis"

myShtComm = "AnalysisComment"



End Select



'Column with data

valCol = Asc(MyCol) - 64

'Column with comment text

comCol = Asc(MyCol) - 67



With Sheets(myShtComm)

'With Sheets("comment sheet that MATCHES the selected sheet from input

box")

'EvalComment or ApplicationComment or AnalysisComment



Set ComRng = .Range(.Cells(3, 1), .Cells(13, 1))

'Range("A3:A13") for two sheets and sheet ApplicationComment only

goes to row 9 but 13 is okay



End With



With Sheets(myShtEAA)



'Evaluation or Application or Analysis (row 6 to 23, col n)

Set Markrng = .Range(.Cells(6, valCol), .Cells(23, valCol))



End With



For Each rngC In Markrng

If Not IsEmpty(rngC) And rngC >= 0 And rngC <= 10 Then

rngC.ClearComments

rngC.AddComment Sheets(myShtComm).Cells(rngC + 3, comCol).Text

End If

Next



End Sub





Regards

Claus B.

--
Click to expand...

Hi Claus,

I was just on my way back with bowed head and hat in hand, because I could not figure how to make the code skip blanks.

I have test flown the latest version and blanks are taken care of and it really is working fine. I tried all three sheets (but not all columns) and this is for sure a winner. I'm pretty confident the rest of the column will be fine.

Another lovely piece of cake, for you that is. The use of the ASCII chars is pretty slick.

Thank a lot. I'll test it some more but am not worried about performance.

Regards,
Howard
 
Just a thought...

Is it possible to hide cols b/c/d so cols e:m *align* on both sheets,
thus obviating the need for offsets?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Back
Top