View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default 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