Advice on multiple macros, same code just a different column
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
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.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
|