View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
L. Howard L. Howard is offline
external usenet poster
 
Posts: 852
Default Advice on multiple macros, same code just a different column

On Saturday, February 15, 2014 1:10:36 AM UTC-8, Claus Busch wrote:
Hi Howard,



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



please test this code:




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 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