Private Sub Worksheet Change Merge problem

andrewb90

andrewb90

Well-known Member
Joined
Dec 16, 2009
Messages
1,077
I have two worksheet change codes I am trying to run on the same page and I have tried putting them together but get odd results. Here is what I have:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Line Highlighting Tool
'>>>>Left Side<<<<
Range("B11:G36").Interior.Color = xlNone
Set S = Application.Intersect(Range(Target.Address), Range("B11:G36"))
If Not S Is Nothing Then
Range("B" & Target.Row & ":G" & Target.Row).Interior.ColorIndex = 6  'Yellow
End If
Range("B40:G40").Interior.Color = xlNone
Set S = Application.Intersect(Range(Target.Address), Range("B40:G40"))
If Not S Is Nothing Then
Range("B" & Target.Row & ":G" & Target.Row).Interior.ColorIndex = 6  'Yellow
End If
'>>>>Right Side<<<<
Range("H11:M42").Interior.Color = xlNone
Set S = Application.Intersect(Range(Target.Address), Range("H11:M42"))
If Not S Is Nothing Then
Range("H" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 6  'Yellow
End If
Range("H44:M55").Interior.Color = xlNone
Set S = Application.Intersect(Range(Target.Address), Range("H44:M55"))
If Not S Is Nothing Then
Range("H" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 6  'Yellow
End If

'Name Requirement Code
If Target.Address(False, False) = "H7" And Len(Target.Value) >= 4 And Len(Target.Value) <= 30 Then
MsgBox "Hello " & Target.Value & ". You may now complete the Daily Sales Report." & vbNewLine & "Have a nice day."
Rows("8:55").Hidden = False
Rows("56:80").Hidden = True
ActiveSheet.Shapes("Papa").Visible = False
Range("H7").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Else
    MsgBox "You MUST have a name typed in!!!  Please tell me who you are.", vbExclamation
    Rows("8:55").Hidden = True
    Rows("56:80").Hidden = False
    ActiveSheet.Shapes("Papa").Visible = True
    Range("H7").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Exit Sub
End If
End Sub

Now both Subs work independently, but I get strange things happening (no error codes)
Any way to properly merge these codes effectively?

Thanks,
Andrew
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    'Line Highlighting Tool
    '>>>>Left Side<<<<
    Range("B11:G36").Interior.Color = xlNone
    Set S = Application.Intersect(Range(Target.Address), Range("B11:G36"))
    If Not S Is Nothing Then
        Range("B" & Target.Row & ":G" & Target.Row).Interior.ColorIndex = 6  'Yellow
    End If
    Range("B40:G40").Interior.Color = xlNone
    Set S = Application.Intersect(Range(Target.Address), Range("B40:G40"))
    If Not S Is Nothing Then
        Range("B" & Target.Row & ":G" & Target.Row).Interior.ColorIndex = 6  'Yellow
    End If
    '>>>>Right Side<<<<
    Range("H11:M42").Interior.Color = xlNone
    Set S = Application.Intersect(Range(Target.Address), Range("H11:M42"))
    If Not S Is Nothing Then
        Range("H" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 6  'Yellow
    End If
    Range("H44:M55").Interior.Color = xlNone
    Set S = Application.Intersect(Range(Target.Address), Range("H44:M55"))
    If Not S Is Nothing Then
        Range("H" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 6  'Yellow
    End If

    'Name Requirement Code
[COLOR="Red"]    If Target.Address(False, False) = "H7" Then
        If Len(Target.Value) >= 4 And Len(Target.Value) <= 30 Then
            MsgBox "Hello " & Target.Value & ". You may now complete the Daily Sales Report." & vbNewLine & "Have a nice day."
            Rows("8:55").Hidden = False
            Rows("56:80").Hidden = True
            ActiveSheet.Shapes("Papa").Visible = False
            Range("H7").BorderAround LineStyle:=xlNone
            
        Else
            MsgBox "You MUST have a name typed in!!!  Please tell me who you are.", vbExclamation
            Rows("8:55").Hidden = True
            Rows("56:80").Hidden = False
            ActiveSheet.Shapes("Papa").Visible = True
            With Range("H7")
                .BorderAround LineStyle:=xlNone
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ThemeColor = 2
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
            End With
        End If
    End If[/COLOR]
End Sub
 
Upvote 0
They both function, however the line highlighting seems to be running differently than before. As soon as I click on one of the cells within the parameters the appropriate adjacent cells on that line should highlight. What is currently happening is nothing is highlighting until after I have edited the cell or double clicked.
 
Upvote 0
Hello Andrew,

I have cleaned the code and made it easier to read and run faster. Try this out abd let me know the results.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim I As Long
    Dim Rng As Range
    Dim S As Range
    
      ' Line Highlighting Tool
        
        For Each Rng In Range("B11:G36,B40:G40,H11:M42,H44:M55").Areas
            Rng.Interior.Color = xlNone
            Set S = Application.Intersect(Target, Rng)
            If Not S Is Nothing Then
                Rng.Rows(S.Row - Rng.Row + 1).Interior.ColorIndex = 6  'Yellow
            End If
        Next Rng
        
      ' Name Requirement Code
  
      ' Remove all borders around H7
        With Range("H7").Borders
            For I = 5 To 12: .Item(I).LineStyle = xlNone: Next I
        End With

        If Target.Address(False, False) = "H7" And Len(Target.Value) >= 4 And Len(Target.Value) <= 30 Then
            MsgBox "Hello " & Target.Value & ". You may now complete the Daily Sales Report." & vbNewLine & "Have a nice day."
            Rows("8:55").Hidden = False
            Rows("56:80").Hidden = True
            ActiveSheet.Shapes("Papa").Visible = False
        Else
            MsgBox "You MUST have a name typed in!!!  Please tell me who you are.", vbExclamation
            Rows("8:55").Hidden = True
            Rows("56:80").Hidden = False
            ActiveSheet.Shapes("Papa").Visible = True
            
            With Range("H7").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ThemeColor = 2
                .TintAndShade = 0
                .Weight = xlMedium
            End With
        End If
       
End Sub
 
Upvote 0
Leith,

The code does seem much easier to read! What's happening is two different things:
First, I still have to double click or start typing into a cell before it will highlight. Second anytime I try to make any changes to a cell my failure message comes up and rehides all my cells asking for my name again.
 
Upvote 0
Hello Andrew,

If you can post your workbook on a file sharing site like MediaFire and post the link back here, I can take a look at the workbook for you.
 
Upvote 0
andrewb90 said:
They both function, however the line highlighting seems to be running differently than before. As soon as I click on one of the cells within the parameters the appropriate adjacent cells on that line should highlight. What is currently happening is nothing is highlighting until after I have edited the cell or double clicked.
Click to expand...

My guess is that you use to have the code that highlights cells located in the Private Sub Worksheet_SelectionChange event procedure. Is that correct?

If you have it in the Worksheet_Change procedure, it won't highlight until after you make a change to a cell.
 
Upvote 0
I haven't looked at your specific code, but a general approach:
Performing multiple tasks in an event procedure
http://www.tushar-mehta.com/publish_train/xl_vba_cases/1021_multiple_tasks_in_an_event_procedure.htm

andrewb90 said:
I have two worksheet change codes I am trying to run on the same page and I have tried putting them together but get odd results. Here is what I have:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Line Highlighting Tool
'>>>>Left Side<<<<
Range("B11:G36").Interior.Color = xlNone
Set S = Application.Intersect(Range(Target.Address), Range("B11:G36"))
If Not S Is Nothing Then
Range("B" & Target.Row & ":G" & Target.Row).Interior.ColorIndex = 6  'Yellow
End If
Range("B40:G40").Interior.Color = xlNone
Set S = Application.Intersect(Range(Target.Address), Range("B40:G40"))
If Not S Is Nothing Then
Range("B" & Target.Row & ":G" & Target.Row).Interior.ColorIndex = 6  'Yellow
End If
'>>>>Right Side<<<<
Range("H11:M42").Interior.Color = xlNone
Set S = Application.Intersect(Range(Target.Address), Range("H11:M42"))
If Not S Is Nothing Then
Range("H" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 6  'Yellow
End If
Range("H44:M55").Interior.Color = xlNone
Set S = Application.Intersect(Range(Target.Address), Range("H44:M55"))
If Not S Is Nothing Then
Range("H" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 6  'Yellow
End If

'Name Requirement Code
If Target.Address(False, False) = "H7" And Len(Target.Value) >= 4 And Len(Target.Value) <= 30 Then
MsgBox "Hello " & Target.Value & ". You may now complete the Daily Sales Report." & vbNewLine & "Have a nice day."
Rows("8:55").Hidden = False
Rows("56:80").Hidden = True
ActiveSheet.Shapes("Papa").Visible = False
Range("H7").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Else
    MsgBox "You MUST have a name typed in!!!  Please tell me who you are.", vbExclamation
    Rows("8:55").Hidden = True
    Rows("56:80").Hidden = False
    ActiveSheet.Shapes("Papa").Visible = True
    Range("H7").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Exit Sub
End If
End Sub

Now both Subs work independently, but I get strange things happening (no error codes)
Any way to properly merge these codes effectively?

Thanks,
Andrew
Click to expand...
 
Upvote 0
AlphaFrog said:
My guess is that you use to have the code that highlights cells located in the Private Sub Worksheet_SelectionChange event procedure. Is that correct?

If you have it in the Worksheet_Change procedure, it won't highlight until after you make a change to a cell.
Click to expand...

Yes, I looked at my original and that is correct. Selection change was the issue. I feel kind of dumb, because having both Subs in there now work perfectly fine.:laugh:

Thanks for everybody's help!
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
312
Micron
M
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
584
RoryA
RoryA
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
1K
kerm007
K
J
  • Question Question
Issue with Macros and renaming files
Replies
6
Views
1K
kevin9999
K
J
  • Question Question
VBA Code to Add Rows is slowing down
Replies
5
Views
989
JayB0730
J

Forum statistics

Threads
1,223,912
Messages
6,175,341
Members
452,638
Latest member
Oluwabukunmi

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top