Dynamic Replacement - "select case" and "set range" help

J

JCamara

New Member
Joined
Jan 14, 2015
Messages
38
I'm fairly new to VBA coding, or any kind of coding at all (had a brief experience on college, 4 or 5 years ago, but with C, html and whatever language Adobe Flash uses), so please, be as didactic as possible.

I've came here with this problem (thread name: Boolean to String on the same cell.) where I have a (huge) worksheet where I input data from paper. And there are lots of paper, so the faster i do it, more relevant things I can do with my working hours.
The data that I input is composed by really long numbers and some words that are standard like "SATISFACTORY", "DAMAGED", "N/A". What I want to happen is to never have to take my hand off the numpad when inputting these words. This really cool guy named Arithos made me some code using "select case" and it worked smoothly. The point is that now I want to go beyond. I want, in some columns (lets say "E:E"), 1=no and 2=yes, and on "A:D" columns i want 1, 2 and 3 respectively as "SATISFACTORY", "DAMAGED", "N/A".
The troubles i'm having are the following:
If i try to breake the code into 2 subs with "select case", it says to me that the name "Worksheet_Change" is a repeated name. If i change one of the subs name second one wont work.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err
If Intersect(Target, Range("A:D")) Is Nothing Or Target.Cells.Count > 1 Then
Exit Sub
Else
    Select Case Target
     
            
        Case Is = 1
            Target.Value = "SATISFACTORY"
        Case Is = 2
            Target.Value = "DAMAGED"
        Case Is = 3
            Target.Value = "N/A"
    
    End Select
 End If
   
Err:
End Sub


Private Sub Worksheet_Change1(ByVal Target As Range)
On Error GoTo Err
If Intersect(Target, Range("E:E")) Is Nothing Or Target.Cells.Count > 1 Then
Exit Sub
Else
    Select Case Target
     
            
        Case Is = 1
            Target.Value = "NO"
        Case Is = 2
            Target.Value = "YES"
   
    End Select
 End If
   
Err:
End Sub

If i try to mesh them in one sub the same thing happens, it will run only first one. I tryed moving the firs "end if" close to second one, so it'd interpret the second if as part of the first else, but it says i have an "if" without end.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err
If Intersect(Target, Range("A:D")) Is Nothing Or Target.Cells.Count > 1 Then
Exit Sub
Else
    Select Case Target
            
        Case Is = 1
            Target.Value = "SATISFACTORY"
        Case Is = 2
            Target.Value = "DAMAGED"
        Case Is = 3
            Target.Value = "N/A" 
    
    End Select
 End If
    
If Intersect(Target, Range("E:E")) Is Nothing Or Target.Cells.Count > 1 Then
Exit Sub
Else
    Select Case Target
        
        Case Is = 1
            Target.Value = "YES"
        Case Is = 2
            Target.Value = "NO"    
    
    End Select
End If

Err:
End Sub

I tried another way, with the code that macro recorder generates when i use find and replace, but I'm stuck with the selection. I dont want to select the columns on the last replace every time i change a cell on my worksheet. I'm realy new to all of this, so i still dont know how to make the active cell go to where it first began. below is my tryout. it says that the method range of the object worksheet has failed. it highlights the "Set previous_range = Range(ActiveCell)" . i tryed adding "me." in front of range but still the same message.


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim previous_range As Range
    
    Set previous_range = Range(ActiveCell)
        
    Columns("A:D").Select
    Selection.Replace What:="1", Replacement:="SATISFACTORY"
    Selection.Replace What:="2", Replacement:="DANIFIED"
    Selection.Replace What:="3", Replacement:="N/A"


    Columns("E:E").Select
    Selection.Replace What:="1", Replacement:="NO"
    Selection.Replace What:="2", Replacement:="YES"


    previous_range.Select


End Sub

I know it's asking too much, but I'm totally into this now, and i really want to learn, if you could comment on the code so i can get a clue of what's going on i'd immensely appreciate. I'm new to VBA but get the basics.
Like... I know that "Worksheet_Change" (created from drop-down menu) triggers whenever a cell changes value on said worksheet, but the reason of it is the "(ByVal Target As Range)"???
I think that "If Intersect(Target, Range("F:J, M:M, W:W, Y:Y, AE:AE, AI:AI, AL:AL")) Is Nothing" means to end the sub if the changed cell (target, am i right?) is outside of the range, but what's the purpose of "Target.Cells.Count > 1" as one of the condition to end sub???
And could someone, pretty please with a cherry on top, explain to me better how the "select case" function works in this particular case?? I get (at least believe) "case" will state conditions for a decision, but from there i cant figure out the structure "select>case>target".

I thankful in advance, and i bet all my doubts seems like retarded stuff for experienced programmers, so i apologize for it and any english mistakes i might have committed.

Regards.
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
After a few attempts i got to a code that's working at least for now:


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim previous_range As Range
    
    If Not Intersect(Target, Range("A:E")) Is Nothing Then
      


    
    Set previous_range = ActiveCell
        
    
    
    Columns("A:D").Select
    Selection.Replace What:="1", Replacement:="SATISFACTORY"
    Selection.Replace What:="2", Replacement:="DANIFIED"
    Selection.Replace What:="3", Replacement:="N/A"


    Columns("E:E").Select
    Selection.Replace What:="1", Replacement:="ALPHA"
    Selection.Replace What:="2", Replacement:="BETA"
    Selection.Replace What:="3", Replacement:="GAMA"




    previous_range.Select
    End If
 
Upvote 0
Seems like nested "Select Case" statements would do the job.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

Select Case Target.Column

     Case Is = 1, 3, 5 ' Column A, C, E

        Select Case Target.Value
            Case Is = 1
                Target.Value = "SATISFACTORY"
            Case Is = 2
                Target.Value = "DAMAGED"
            Case Is = 3
            Target.Value = "N/A"
        End Select
        
    Case Is = 2 ' Column B

        Select Case Target.Value
            Case Is = 1
                Target.Value = "YES"
            Case Is = 2
                Target.Value = "NO"
            Case Else
                Target.Value = "???"
        End Select
        
    Case Is = 26 ' Column Z ...
                
End Select

Application.EnableEvents = True

End Sub


The "OnKey" method may also be an effective way to do this type of "shorthand" entry. "S" for Satisfactory, "D" for Damaged ...

https://msdn.microsoft.com/en-us/library/office/ff197461(v=office.15).aspx

what's the purpose of "Target.Cells.Count > 1" as one of the condition to end sub???
Click to expand...
Target is a range. It can be one cell or the entire worksheet. If there is more than one cell in Target you want it to abort (in this particular case).

triggers whenever a cell changes value on said worksheet, but the reason of it is the "(ByVal Target As Range)"???
Click to expand...
A cell is a range. It can be 1,2 or 10K cells.
 
Upvote 0
Hey, Gary! Thank you for the tip, onKey seems like a neat method, i'll study it later on.

About the nested "select case" method, i'll give it a try later, since my shift is ending right now. i believe i'm beginning to understand its structure. really helpful, mate! thanks!

I spent the afternoon trying to make it work. the last code i posted worked fine, but i needed it not to trigger whenever i changed any cell of the sheet, so i added an "if not intersect is nothing" instruction. first i kept all columns in same "if" range, then i made an "if" for each column i'd want to replace


it worked really well on an empt workbook, heres the code i came with.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim previous_range As Range
        
    Set previous_range = ActiveCell
    
    
        If Not Intersect(Target, Range("F:G, I:I")) Is Nothing Then
            Range("F:G, I:I").Select
                Selection.Replace What:="1", Replacement:="SATISFATÓRIO"
                Selection.Replace What:="2", Replacement:="OXIDAÇÃO"
                Selection.Replace What:="3", Replacement:="INFILTRAÇÃO"
                Selection.Replace What:="3", Replacement:="A/C"
            previous_range.Select
        End If
            
            
        If Not Intersect(Target, Range("H:H")) Is Nothing Then
            Range("H:H").Select
                Selection.Replace What:="1", Replacement:="ÁRVORES"
                Selection.Replace What:="2", Replacement:="PRÉDIOS"
                Selection.Replace What:="3", Replacement:="A/C"
            previous_range.Select
        End If
                
                
        If Not Intersect(Target, Range("J:J, M:M, W:W, Y:Y")) Is Nothing Then
            Range("J:J, M:M, W:W, Y:Y").Select
                Selection.Replace What:="1", Replacement:="SIM"
                Selection.Replace What:="2", Replacement:="NÃO"
            previous_range.Select
        End If
    
    
        If Not Intersect(Target, Range("R:R, T:T")) Is Nothing Then
            Range("R:R, T:T").Select
                Selection.Replace What:="1", Replacement:="UNIPOWER"
                Selection.Replace What:="2", Replacement:="PACK"
            previous_range.Select
        End If




        If Not Intersect(Target, Range("V:V")) Is Nothing Then
            Range("V:V").Select
                Selection.Replace What:="1", Replacement:="FLEXCOM"
                Selection.Replace What:="2", Replacement:="CELLO"
                Selection.Replace What:="3", Replacement:="ISA"
            previous_range.Select
        End If




        If Not Intersect(Target, Range("AA:AA")) Is Nothing Then
            Range("AA:AA").Select
                Selection.Replace What:="1", Replacement:="CORUS"
                Selection.Replace What:="2", Replacement:="NEWLOG"
                Selection.Replace What:="3", Replacement:="INSTROMET"
            previous_range.Select
        End If
  
  
        If Not Intersect(Target, Range("AB:AB")) Is Nothing Then
            Range("AB:AB").Select
                Selection.Replace What:="1", Replacement:="OK"
                Selection.Replace What:="2", Replacement:="NOK"
            previous_range.Select
        End If
  
   
        If Not Intersect(Target, Range("AE:AE, AI:AI")) Is Nothing Then
            Range("AE:AE, AI:AI").Select
                Selection.Replace What:="1", Replacement:="CLARO"
                Selection.Replace What:="2", Replacement:="TIM"
                Selection.Replace What:="3", Replacement:="VIVO"
            previous_range.Select
        End If
  
   
        If Not Intersect(Target, Range("AK:AK")) Is Nothing Then
            Range("AK:AK").Select
                Selection.Replace What:="1", Replacement:="BATERIA"
                Selection.Replace What:="2", Replacement:="CHIP"
                Selection.Replace What:="3", Replacement:="RESET NO MODEM"
            previous_range.Select
        End If
   
   
   
End Sub

the replacements is what i use in pratic (brazilian portuguese), i hope you guys dont mind it...


but i once implemented it on the workbook i have all the data, it began to replace on other columns i didnt want it to, and since its an "find and replace" method, it messed up all my older numeric data, replacing 1s and 2s (of several other columns) from the middle of values.
I believe (its an instinct, since im a total VBA noob, lol) thats happening because of the double negative on "if not intersect is nothing" structure, but i'm not sure...

just in case it helps any much to solve the problem, the columns being altered without my will are Z, X, V, U, S, Q, P, O, N, L and K. it replaces all 1s and 2s (middle string and stuff) for "SIM" and "NÃO" respectively (from that i guess that my mistake is on lines 29 and 30 from my code...)

thanks in advance!

regards
 
Upvote 0
It is good practice to Disable/Enable events with this change procedure (among others):

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

' Your code

Application.EnableEvents = True

End Sub

If your code makes a change inside the CHANGE event (which yours does), it causes a recursive call to the event. This can and will cause big problems. Application.EnableEvents prevents that recursion. If your procedure bombs before you turn the events back on you can paste Application.EnableEvents = True in the immediate (debug) window and press enter to turn the events back on. You can also create a "Reset" procedure that contains only the line Application.EnableEvents = True
 
Upvote 0
You must log in or register to reply here.

Similar threads

SaraWitch
  • Solved
Run Multiple Private Sub Worksheet_Change(ByVal Target As Range)
Replies
5
Views
703
Joe4
Joe4
M
  • Solved
Trying to apply 2 Worksheet Changes
Replies
1
Views
133
Joe4
Joe4
L
  • Solved
Bi-directional (two-way) Link in Excel using cells in multiple rows and columns
2 3
Replies
29
Views
1K
louperrotta
L
excelbytes
  • Solved
Looping Procedure In VBA Code
2 3
Replies
24
Views
415
excelbytes
excelbytes
M
  • Question Question
Where to protect sheet in this code?
Replies
1
Views
86
Micron
M

Forum statistics

Threads
1,223,228
Messages
6,170,875
Members
452,363
Latest member
merico17

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