Worksheet_Change when user Drags File Handle or Copy/Paste Multiple

D

djjack37

New Member
Joined
Jan 20, 2016
Messages
7
I have the following Worksheet_Change code that works perfectly when a single cell in the target range is changed (B11:B & LastUsedRow). However, the code fails when a user copy/pastes multiple values or drags the file handle to pull a string down the cells. I've hit a mental roadblock on how to modify this code to accomodate it. Any ideas/suggestions is greatly appreciated. Below is the code that I am using.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim targ As Range
Dim glFormat, jobFormat, phaseFormat, strInput As String
Dim partChars As Integer

glFormat = "    -   -    -    "         '4R-3R-4R-4RN
jobFormat = "      -   "                '6R-3RN
phaseFormat = "    -    -      -   "    '4R-4R-6R-3RN

Application.EnableEvents = True

'Exit Sub if more than 1 column is changed
If Target.Columns.Count > 1 Then Exit Sub

Set targ = Intersect(Target, Range("B:B")) 'First Check Customer Column for update

If Not targ Is Nothing Then
    Application.EnableEvents = False
    Select Case UCase(Target.Value)
        Case "GL"
            'Highlight The GL Cell as Required and all others grey
            Cells(Target.Row, 13).Interior.ColorIndex = 36
            Range("N" & Target.Row, "R" & Target.Row).Interior.ColorIndex = 56
            Cells(Target.Row, 18).Value = ""
            
        Case "JOB"
            'Highlight The Job and Phase Cells as Required and all others grey
            Range("N" & Target.Row, "O" & Target.Row).Interior.ColorIndex = 36
            Cells(Target.Row, 18).Interior.ColorIndex = 36
            Cells(Target.Row, 13).Interior.ColorIndex = 56
            Range("P" & Target.Row, "Q" & Target.Row).Interior.ColorIndex = 56
            
            'Set Default CT to 4
            Cells(Target.Row, 18).Value = 4
            
        Case "SMWO"
            'Highlight The SMWO and Scope Cells as Required and all others grey
            Range("P" & Target.Row, "Q" & Target.Row).Interior.ColorIndex = 36
            Cells(Target.Row, 13).Interior.ColorIndex = 56
            Range("M" & Target.Row, "O" & Target.Row).Interior.ColorIndex = 56
            
            'Set Default CT to 4
            Cells(Target.Row, 18).Value = 4
        Case ""
            Range("M" & Target.Row, "R" & Target.Row).Interior.ColorIndex = xlColorIndexNone
            'Remove CT
            Cells(Target.Row, 18).Value = ""
        Case Else
            'Do Nothing
    End Select
    Application.EnableEvents = True
Else
    'Disable Events So there is not an infinite loop and start checking other columns for update
    Application.EnableEvents = False
    
    Set targ = Intersect(Target, Range("M:M")) 'Check GL Column for Change
    If Not targ Is Nothing Then
        'Format the GL Number if it was not being cleared
        If Target.Value <> "" Then
            strInput = Trim(Replace(Target.Value, "-", ""))
            Select Case Len(strInput)
                Case Is <= 4
                    Target.Value = Right(Left(glFormat, 4) & strInput, 4) & Right(glFormat, 14)
                Case 5 To 7
                    'Count Digits beyond Part1
                    partChars = Len(strInput) - 4
                    Target.Value = Right(Left(glFormat, 4) & Left(strInput, 4), 4) & Right(Mid(glFormat, 5, 4 - partChars) & Right(strInput, partChars), 4) & Right(glFormat, 10)
                Case 8 To 11
                    'Count Digits beyond Part2
                    partChars = Len(strInput) - 7
                    Target.Value = Right(Left(glFormat, 4) & Left(strInput, 4), 4) & Right("-" & Mid(strInput, 5, 3), 4) & _
                        Right(Mid(glFormat, 9, 5 - partChars) & Right(strInput, partChars), 5) & Right(glFormat, 5)
                Case 12 To 15
                    'Count Digits beyond Part3
                    partChars = Len(strInput) - 11
                    Target.Value = Right(Left(glFormat, 4) & Left(strInput, 4), 4) & Right("-" & Mid(strInput, 5, 3), 4) & _
                        Right("-" & Mid(strInput, 8, 4), 5) & Right(Mid(glFormat, 14, 4 - partChars) & Right(strInput, partChars), 4)
                Case Else
                    MsgBox "Too many digits are in the GL Code. Please Re-enter."
            End Select
        End If
    Else
        Set targ = Intersect(Target, Range("N:N")) 'Check the Job Column for Change
        If Not targ Is Nothing Then
            'Format the Job Number if it was not being cleared
            If Target.Value <> "" Then
                strInput = Replace(Target.Value, "-", "")
                Select Case Len(strInput)
                    Case Is <= 6
                        Target.Value = Right(Left(jobFormat, 6 - Len(strInput)) & strInput, 6) & Right(jobFormat, 4)
                    Case 7 To 9
                        'Count Digits beyond Part1
                        partChars = Len(strInput) - 6
                        Target.Value = Right(Left(jobFormat, 6) & Left(strInput, 6), 6) & Right(Mid(jobFormat, 7, 4 - partChars) & Right(strInput, partChars), 4)
                    Case Else
                        MsgBox "Too many digits are in the Job Number. Please Re-enter."
                End Select
            End If
        Else
            Set targ = Intersect(Target, Range("O:O")) 'Check the Phase Column for Change
            If Not targ Is Nothing Then
                'Format the Phase Code if it is not being cleared
                If Target.Value <> "" Then
                    strInput = Trim(Replace(Target.Value, "-", ""))
                    Select Case Len(strInput)
                        Case Is <= 4
                            Target.Value = Right(Left(phaseFormat, 4) & strInput, 4) & Right(phaseFormat, 16)
                        Case 5 To 8
                            'Count Digits beyond Part1
                            partChars = Len(strInput) - 4
                            Target.Value = Right(Left(phaseFormat, 4) & Left(strInput, 4), 4) & Right(Mid(phaseFormat, 5, 5 - partChars) & Right(strInput, partChars), 5) & Right(phaseFormat, 11)
                        Case 9 To 14
                            'Count Digits beyond Part2
                            partChars = Len(strInput) - 8
                            Target.Value = Right(Left(phaseFormat, 4) & Left(strInput, 4), 4) & Right("-" & Mid(strInput, 5, 4), 5) & _
                                Right(Mid(phaseFormat, 10, 7 - partChars) & Right(strInput, partChars), 7) & Right(phaseFormat, 4)
                        Case 15 To 17
                            'Count Digits beyond Part3
                            partChars = Len(strInput) - 14
                            Target.Value = Right(Left(phaseFormat, 4) & Left(strInput, 4), 4) & Right("-" & Mid(strInput, 5, 4), 5) & _
                                Right("-" & Mid(strInput, 9, 6), 7) & Right(Mid(phaseFormat, 17, 4 - partChars) & Right(strInput, partChars), 4)
                        Case Else
                            MsgBox "Too many digits are in the Phase Code. Please Re-enter."
                    End Select
                End If
            End If
        End If
    End If
    
    'Enable Events
    Application.EnableEvents = True
End If
End Sub
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
You will want to loop through each cell in the Target range. The way you will want to do this is to break your code up into a separate block for each range your are checking, and loop through ALL cells in that Target range. Each block will be structured the same. Listed below, I show how you want change the first block and start the second (and just repeat that pattern):
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim targ As Range
Dim glFormat, jobFormat, phaseFormat, strInput As String
Dim partChars As Integer
Dim c As Range

glFormat = "    -   -    -    "         '4R-3R-4R-4RN
jobFormat = "      -   "                '6R-3RN
phaseFormat = "    -    -      -   "    '4R-4R-6R-3RN

Application.EnableEvents = True

'***FIRST CHECK***
Set targ = Intersect(Target, Range("B:B")) 'First Check Customer Column for update

If Not targ Is Nothing Then
    For Each c In targ
   
        Application.EnableEvents = False
        Select Case UCase(c.Value)
            Case "GL"
                'Highlight The GL Cell as Required and all others grey
                Cells(c.Row, 13).Interior.ColorIndex = 36
                Range("N" & c.Row, "R" & c.Row).Interior.ColorIndex = 56
                Cells(c.Row, 18).Value = ""
           
            Case "JOB"
                'Highlight The Job and Phase Cells as Required and all others grey
                Range("N" & c.Row, "O" & c.Row).Interior.ColorIndex = 36
                Cells(c.Row, 18).Interior.ColorIndex = 36
                Cells(c.Row, 13).Interior.ColorIndex = 56
                Range("P" & c.Row, "Q" & c.Row).Interior.ColorIndex = 56
           
                'Set Default CT to 4
                Cells(c.Row, 18).Value = 4
           
            Case "SMWO"
                'Highlight The SMWO and Scope Cells as Required and all others grey
                Range("P" & c.Row, "Q" & c.Row).Interior.ColorIndex = 36
                Cells(c.Row, 13).Interior.ColorIndex = 56
                Range("M" & c.Row, "O" & c.Row).Interior.ColorIndex = 56
           
                'Set Default CT to 4
                Cells(c.Row, 18).Value = 4
               
            Case ""
                Range("M" & c.Row, "R" & c.Row).Interior.ColorIndex = xlColorIndexNone
                'Remove CT
                Cells(c.Row, 18).Value = ""
           
            Case Else
                'Do Nothing
    End Select
    Application.EnableEvents = True
End If
   
'Disable Events So there is not an infinite loop and start checking other columns for update
Application.EnableEvents = False
   
   
'***SECOND CHECK***
Set targ = Intersect(Target, Range("M:M")) 'Check GL Column for Change
   
...

You should be able to see that pattern, and repeat it for the other ranges that you have.
 
Upvote 0
Solution
You are welcome!
Glad I was able to help.
:)
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
306
tixarah
T
Q
  • Solved
VBA: Dynamically Create Active X Frame and Yes / No Radio Button
2
Replies
13
Views
173
Domenic
D
A
  • Question Question
[Excel / VBA] How do align some columns exporting to TXT?
Replies
3
Views
303
Joe4
Joe4
T
  • Question Question
VBA to run when a table with a SQL query is refreshed?
Replies
0
Views
179
Tarver
T
K
  • Solved
VBA Code - Trim function
Replies
6
Views
1K
Fluff
Fluff

Forum statistics

Threads
1,223,888
Messages
6,175,207
Members
452,618
Latest member
Tam84

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