Code review please!

N

NikonMan

New member
Joined
Feb 7, 2013
Messages
4
Reaction score
0
Points
0
Greetings!

I am trying to merge the following worksheet change subs into one VBA and am so far unsuccessful - I can get the first three to work, but the 4th section "'thow input box if GM type = DS or RDM" won't fire work when combined into one.


Any ideas?


Many thanks in advance!!!


First section:


Code: 
'main VBA
Private Sub Worksheet_Change(ByVal Target As Range)
'set date field automatically once user is selected in row 1
Dim yourdate As String
yourdate = Format(Date, "yyyy-mm-dd")


If Target.Column >= 1 And Target.Column <= 1 Then


With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With


Cells(Target.Row, 2) = (yourdate)


With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With


End If


'validate drive letter or mount point but not both
If Target.Row >= 5 <= 105 Then
    If (Target.Column = 15) Then
If (Me.Range("Q" & Target.Row).Value <> "") Then
            UndoValue
        End If
            ElseIf (Target.Column = 17) Then
            If (Me.Range("O" & Target.Row).Value <> "") Then
            UndoValue
            End If
     End If
End If


'change SCSI id field to 'NA' based on GM role
If Intersect(Target, Range("R5:R55")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then
  Me.Range("M" & Target.Row) = ""
  Exit Sub
End If
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  Select Case Target.Value
    Case "H1", "H2", "J2"
      Me.Range("M" & Target.Row).Value = Application.RandBetween(1, 99)
    Case "I2"
      Me.Range("M" & Target.Row) = "NA"
  End Select
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub


'sub to undo incorrect value
Private Sub UndoValue()
With Application
  .EnableEvents = False
  .ScreenUpdating = False
        Application.Undo
  .EnableEvents = True
  .ScreenUpdating = True
End With
    MsgBox "Please choose a drive letter OR a mount point, not both.", vbExclamation
End Sub


Second section:


Code: 
'main VBA
Private Sub Worksheet_Change(ByVal Target As Range)
'thow input box if GM type = DS or RDM 
Dim mynum As Integer
On Error GoTo errHandler:
If Target.Row > 4 And Target.Row < 106 And Target.Column = 11 Then
If Target.Value = "DS" Then
    mynum = InputBox( _
    "You have selected a LUN type that may require a series identifier (e.g. DS1, 2, 3, 3, etc.). If not, please click Cancel.", _
    "LUN Series Number ...", _
    "Assign a series number? If so please enter a value between 1 - 200.")
    If mynum > 200 Or mynum < 1 Then
    MsgBox "Invalid Entry - Enter a value between 1 - 200", vbExclamation
    Exit Sub
    End If
   Cells(Target.Row, Target.Column + 1) = mynum
ElseIf Target.Value = "RDM" Then
    mynum = InputBox( _
    "You have selected a LUN type that may require a series identifier (e.g. RDM1, 2, 3, 3, etc.) If not, please click Cancel.", _
    "LUN Series Number ...", _
    "Assign a series number? If so please enter a value between 1 - 200.")
    If mynum > 200 Or mynum < 1 Then
    MsgBox "Invalid Entry - Enter a value between 1 - 200.", vbExclamation
    Exit Sub
    End If
   Cells(Target.Row, Target.Column + 1) = mynum
End If
End If
Exit Sub
errHandler:
MsgBox "No LUN Series Number Chosen.", vbInformation
End Sub
 
Untested

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)Const MSG_INVALID_LUN_SERIES_ID As String = _
    "Invalid Entry - Enter a value between 1 - 200"
Const MSG_NO_LUN_SERIES_ID As String = _
    "No LUN Series Number Chosen."
Const MSG_LUN_SERIES_ID As String = _
    "You have selected a LUN type that may require a series identifier " & _
    "(e.g. <type>1, 2, 3, 3, etc.) If not, please click Cancel."
Const TITLE_LUN_SERIES_ID As String = "LUN Series Number ..."
Const DEFAULT_LUN_SERIES_ID As String = ""
Dim mynum As Long


    If Target.Count > 1 Then Exit Sub
    
    On Error GoTo errHandler


    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With


    Select Case True
    
        Case Target.Column >= 1 And Target.Column <= 1
        
            'set date field automatically once user is selected in row 1
            Me.Cells(Target.Row, 2) = Format(Date, "yyyy-mm-dd")


        Case Target.Row >= 5 And Target.Row <= 105
        
            'validate drive letter or mount point but not both
            If Target.Column = 15 Then
            
                If Me.Range("Q" & Target.Row).Value <> "" Then
                
                    UndoValue
                End If
            ElseIf Target.Column = 17 Then
            
                If Me.Range("O" & Target.Row).Value <> "" Then
                
                    UndoValue
                End If
            End If


        Case Not Intersect(Target, Me.Range("R5:R55")) Is Nothing
                 
            'change SCSI id field to 'NA' based on GM role
            If Target = "" Then
      
                Me.Range("M" & Target.Row) = ""
                Exit Sub
            End If
            
            Select Case Target.Value
              
                Case "H1", "H2", "J2"
                    Me.Range("M" & Target.Row).Value = Application.RandBetween(1, 99)
                
                Case "I2"
                    Me.Range("M" & Target.Row) = "NA"
            End Select


        Case Target.Row > 4 And Target.Row < 106 And Target.Column = 11
        
            'thow input box if GM type = DS or RDM
            If Target.Value = "DS" Then
            
                mynum = InputBox(Replace(MSG_SERIES_ID, "<type>", "DS"), _
                                 TITLE_LUN_SERIES_ID, _
                                 DEFAULT_LUN_SERIES_ID)
                If mynum > 200 Or mynum < 1 Then
                
                    MsgBox MSG_INVALID_LUN_SERIES_ID, vbExclamation, TITLE_LUN_SERIES_ID
                    Exit Sub
                End If
           
                Me.Cells(Target.Row, Target.Column + 1) = mynum
            ElseIf Target.Value = "RDM" Then
            
                mynum = InputBox(Replace(MSG_SERIES_ID, "<type>", "RDM"), _
                                 TITLE_LUN_SERIES_ID, _
                                 DEFAULT_LUN_SERIES_ID)
                If mynum > 200 Or mynum < 1 Then
                
                    MsgBox MSG_INVALID_LUN_SERIES_ID, vbExclamation, TITLE_LUN_SERIES_ID
                    Exit Sub
                End If
           
                Me.Cells(Target.Row, Target.Column + 1) = mynum
            End If
    End Select


teardown:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
    Exit Sub
    
errHandler:
    MsgBox MSG_NO_LUN_SERIES_ID, vbInformation, TITLE_LUN_SERIES_ID
    Resum teardown
End Sub


'sub to undo incorrect value
Private Sub UndoValue()
    With Application
      
      .EnableEvents = False
      .ScreenUpdating = False
            
      Application.Undo
      
      .EnableEvents = True
      .ScreenUpdating = True
    End With
    
    MsgBox "Please choose a drive letter OR a mount point, not both.", vbExclamation
End Sub
 
Thanks Bob - I tried your code and it hung with a compile error "Constant expression required" for this line: "TITLE_LUN_SERIES_ID, _"

Your revisions are WAY over my head so I am afraid as best I tried I cannot debug it any further.

Anyways, I don't think I was as clear as I needed to be as to what I was trying to get done and what the issue is ...

Here is the revised ("merged") version of the VBA with more detail as to the actions I am trying to accomplish (see inline comments).

Obviously I am not a developer (I am a SAN Architect that has been tasked with this) - so my code is probably horribly sloppy etc. Most of it has been pieced together here and there and for the most part it all works EXCEPT the last section (which is what I am stuck on).

I still cannot seem to get anywhere with it - I am hoping one of the crack developers here can look at it and in 5 minutes see where the issue(s) are :)

-Steve
Code: 
 Private Sub Worksheet_Change(ByVal Target As Range)'if column "A" (1) contains a value, set the cell value in the same row, column "B" (2), to the current date -> WORKS
Dim yourdate As String
yourdate = Format(Date, "yyyy-mm-dd")


If Target.Column >= 1 And Target.Column <= 1 Then


With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With


Cells(Target.Row, 2) = (yourdate)


With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With


End If


'for rows 4-106, cell values can have data in columns "O" (15) OR "Q" (17), but not both - if both exist, call undo sub to delete the last entry and display error message -> WORKS
If Target.Row >= 4 <= 106 Then
    If (Target.Column = 15) Then
If (Me.Range("Q" & Target.Row).Value <> "") Then
            UndoValue
        End If
            ElseIf (Target.Column = 17) Then
            If (Me.Range("O" & Target.Row).Value <> "") Then
            UndoValue
            End If
     End If
End If


'for rows 4-106,if the cell value in column "R" (18), = "I2", change the same row value in column "M" (13) to 'NA", else the value in column M (13) can be any integer between 1 and 99 -> WORKS
If Intersect(Target, Range("R5:R55")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then
  Me.Range("M" & Target.Row) = ""
  Exit Sub
End If
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  Select Case Target.Value
    Case "H1", "H2", "J2"
      Me.Range("M" & Target.Row).Value = Application.RandBetween(1, 99)
    Case "I2"
      Me.Range("M" & Target.Row) = "NA"
  End Select
  .EnableEvents = True
  .ScreenUpdating = True
End With


'for rows 4-106, if cell value in column "K" (11) = "DS" or "RDM", then throw an input box to prompt for integer value between 1 and 200, if user inputs data, set cell in the same row, column "L" (12) = to the input box value, else exit. -> DOES NOT WORK
Dim mynum As Integer
On Error GoTo errHandler:
If Target.Row > 4 And Target.Row < 106 And Target.Column = 11 Then
If Target.Value = "DS" Then
    mynum = InputBox( _
    "You have selected a LUN type that may require a series identifier (e.g. DS1, 2, 3, 3, etc.). If not, please click Cancel.", _
    "LUN Series Number ...", _
    "Assign a series number? If so please enter a value between 1 - 200.")
    If mynum > 200 Or mynum < 1 Then
    MsgBox "Invalid Entry - Enter a value between 1 - 200", vbExclamation
    Exit Sub
    End If
   Cells(Target.Row, Target.Column + 1) = mynum
ElseIf Target.Value = "RDM" Then
    mynum = InputBox( _
    "You have selected a LUN type that may require a series identifier (e.g. RDM1, 2, 3, 3, etc.) If not, please click Cancel.", _
    "LUN Series Number ...", _
    "Assign a series number? If so please enter a value between 1 - 200.")
    If mynum > 200 Or mynum < 1 Then
    MsgBox "Invalid Entry - Enter a value between 1 - 200.", vbExclamation
    Exit Sub
    End If
   Cells(Target.Row, Target.Column + 1) = mynum
End If
End If
Exit Sub
errHandler:
MsgBox "No LUN Series Number Chosen.", vbInformation
End Sub


'sub to delete last entry and display message -> WORKS
Private Sub UndoValue()
With Application
  .EnableEvents = False
  .ScreenUpdating = False
        Application.Undo
  .EnableEvents = True
  .ScreenUpdating = True
End With
    MsgBox "Please choose a drive letter OR a mount point, not both.", vbExclamation
End Sub
 
I don't know what was going on there, I just re-typed the text and it was fine. Here is an updated version

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Const MSG_LUN_SERIES_ID As String = _
    "You have selected a LUN type that may require a series identifier " & _
    "(e.g. <type>1, 2, 3, 3, etc.) If not, please click Cancel."
Const TITLE_LUN_SERIES_ID As String = "LUN Series Number ..."
Const DEFAULT_LUN_SERIES_ID As String = _
    "Assign a series number? If so please enter a value between 1 - 200."
Const MSG_INVALID_LUN_SERIES_ID As String = _
    "Invalid Entry - Enter a value between 1 - 200"
Const MSG_NO_LUN_SERIES_ID As String = _
    "No LUN Series Number Chosen"
Dim mynum As Variant


    If Target.Count > 1 Then Exit Sub
    
    On Error GoTo errHandler


    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With




    If Target.Column >= 1 And Target.Column <= 1 Then
        
        'set date field automatically once user is selected in row 1
        Me.Cells(Target.Row, 2) = Format(Date, "yyyy-mm-dd")
    End If




    If Target.Row >= 5 And Target.Row <= 105 Then
        
        'validate drive letter or mount point but not both
        Select Case Target.Column
        
            Case 15
                If Me.Range("Q" & Target.Row).Value <> "" Then
                
                    UndoValue
                End If
         
            Case 17
                If Me.Range("O" & Target.Row).Value <> "" Then
                
                    UndoValue
                End If
        End Select
    End If
    


    If Not Intersect(Target, Me.Range("R5:R55")) Is Nothing Then
                 
        'change SCSI id field to 'NA' based on GM role
        Select Case Target.Value
         
            Case ""
                Me.Range("M" & Target.Row) = ""
        
            Case "H1", "H2", "J2"
                Me.Range("M" & Target.Row).Value = Application.RandBetween(1, 99)
          
            Case "I2"
                Me.Range("M" & Target.Row) = "NA"
        End Select
    End If
    


    If Target.Row > 4 And Target.Row < 106 And Target.Column = 11 Then
        
         'throw input box if GM type = DS or RDM
         Select Case Target.Value
         
            Case "DS"
                mynum = InputBox(Replace(MSG_LUN_SERIES_ID, "<type>", "DS"), _
                                 TITLE_LUN_SERIES_ID, _
                                 DEFAULT_LUN_SERIES_ID)
         
            Case "RDM"
                mynum = InputBox(Replace(MSG_LUN_SERIES_ID, "<type>", "RDM"), _
                                 TITLE_LUN_SERIES_ID, _
                                 DEFAULT_LUN_SERIES_ID)
         End Select
         
         If mynum <> "" Then
         
            If mynum >= 1 And mynum <= 200 Then
         
                Me.Cells(Target.Row, Target.Column + 1) = mynum
            Else
    
                MsgBox MSG_INVALID_LUN_SERIES_ID, vbExclamation, TITLE_LUN_SERIES_ID
            End If
        End If
    End If


teardown:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
    Exit Sub
    
errHandler:
    MsgBox MSG_NO_LUN_SERIES_ID, vbInformation, TITLE_LUN_SERIES_ID
    Resume teardown
End Sub


'sub to undo incorrect value
Private Sub UndoValue()
    With Application
      
      .EnableEvents = False
      .ScreenUpdating = False
            
      Application.Undo
      
      .EnableEvents = True
      .ScreenUpdating = True
    End With
    
    MsgBox "Please choose a drive letter OR a mount point, not both.", vbExclamation
End Sub
 
Seems perfect so far !

Thanks so much for your time :)
-Steve
 
Last edited by a moderator:
You must log in or register to reply here.
Back
Top