Need simple solution, should be easy

[bomberman411]

Hi all,

I need a simple solution to make a mass-change in about 4000 cells.

My spreadsheet has over 4000 lines of data. One of my columns is for employee numbers. It's a 6 digit number (like 106500). The 10 in front of the number was tagged on a while back by our human-resources departement, it used to be a 4 digit number. We had to correct all the data a while back and add a "10" in front of each number. Some have a "20" tagged in front of it, others a "40"... basically this means that the real number to keep is the four last digits.

I need to take out the second digit in each number, in each cell. That digit should be "0" for all those employee numbers. So "106500" becomes "16500"... "409400" should become "49400"....

My data, the employee numbers, are in column "D" and starts at row "10".

I already have a "Worksheet_Change" event to change case to "ProPeR" for all the employee names, and I would like to use that same code to check if the employee number is 6 digits long or 5. If it's 6, it should remove the 2nd digit. If it's 5 then it should be left untouched.

Here's the code I already have:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngProper As Range, Cell As Range
    Set rngProper = Intersect(Range("B6:B1000,C6:C1000"), Target)
    On Error GoTo ws_exit:
    Application.EnableEvents = False
    If Not rngProper Is Nothing Then
        For Each Cell In rngProper
            Cell.Value = WorksheetFunction.Proper(Cell.Value)
        Next Cell
    End If
ws_exit:
    Application.EnableEvents = True
End Sub

I appreciate all the help I can get on this one... even though I have backups, I can't make any mistakes on this one, the file is too important.

 

[xld]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngProper As Range, rngIDs As Range, Cell As Range
    
    On Error GoTo ws_exit:
    Set rngIDs = Range("A6:A1000")
    Set rngProper = Range("B6:B1000,C6:C1000")
    Application.EnableEvents = False
    If Not Intersect(rngProper, Target) Is Nothing Then
    
        For Each Cell In rngProper
        
            Cell.Value = WorksheetFunction.Proper(Cell.Value)
        Next Cell
    ElseIf Not Intersect(rngIDs, Target) Is Nothing Then
    
        For Each Cell In rngIDs
        
            If Len(Cell.Value) = 6 Then
            
                Cell.Value = Left(Cell.Value, 1) * 10000 + Right(Cell.Value, 4)
            End If
        Next Cell
    End If
    
ws_exit:
    Application.EnableEvents = True
End Sub

 

[MickG]

Hi, Try this:-

Dim Rng As Range, Dn As Range
Set Rng = Range(Range("D10"), Range("D" & Rows.Count).End(xlUp))
    For Each Dn In Rng
        If Len(Dn) = 6 Then
            Dn = Left(Dn, 1) & Right(Dn, 4)
        End If
Next Dn

Regards Mick

 

[bomberman411]

Thanks for your quick replies... i'm not quite sure which one to try.... one incorporates the code I already have but the other code seems more streamlined... both have the same "If" to check the number of characters, but I don't under stand what this code does

Cell.Value = Left(Cell.Value, 1) * 10000 + Right(Cell.Value, 4)

or this one:

Dn = Left(Dn, 1) & Right(Dn, 4)

They both seem to do the same thing, but writen in different ways.... I'm usually more comfortable with "cell.value"... don't know what the other one means. Which one should I use?

 

[bomberman411]

Ok I tried the following code and it's not doing anything at all:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngProper As Range, rngIDs As Range, Cell As Range
    On Error GoTo ws_exit:
    Set rngIDs = Range("D10:D10000")
    Set rngProper = Range("B10:B10000,C10:C10000")
    Application.EnableEvents = False
    If Not Intersect(rngProper, Target) Is Nothing Then
        For Each Cell In rngProper
            Cell.Value = WorksheetFunction.Proper(Cell.Value)
        Next Cell
    ElseIf Not Intersect(rngIDs, Target) Is Nothing Then
        For Each Cell In rngIDs
            If Len(Cell.Value) = 6 Then
                Cell.Value = Left(Cell.Value, 1) * 10000 + Right(Cell.Value, 4)
            End If
        Next Cell
    End If
ws_exit:
    Application.EnableEvents = True
End Sub

 

[bomberman411]

I also tried this but it's not working either:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngProper As Range, Rng As Range, Dn As Range, Cell As Range
    On Error GoTo ws_exit:
    Set Rng = Range(Range("D10"), Range("D" & Rows.Count).End(xlUp))
    Set rngProper = Range("B10:B10000,C10:C10000")
    Application.EnableEvents = False
    If Not Intersect(rngProper, Target) Is Nothing Then
        For Each Cell In rngProper
            Cell.Value = WorksheetFunction.Proper(Cell.Value)
        Next Cell
        For Each Dn In Rng
            If Len(Dn) = 6 Then
                Dn = Left(Dn, 1) & Right(Dn, 4)
            End If
        Next Dn
    End If
ws_exit:
    Application.EnableEvents = True
End Sub

 

[bomberman411]

Ok, this is my third attempt... and it's not doing anything to the employee numbers... but the Proper casing's still working.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngProper As Range, rngIDs As Range, Cell1 As Range, Cell2 As Range
On Error GoTo ws_exit:
    Set rngIDs = Range("D10:D10000")
    Set rngProper = Range("B10:B10000,C10:C10000")
    Application.EnableEvents = False
    If Not Intersect(rngProper, Target) Is Nothing Then
        For Each Cell1 In rngProper
            Cell1.Value = WorksheetFunction.Proper(Cell1.Value)
        Next Cell1
    ElseIf Not Intersect(rngIDs, Target) Is Nothing Then
        For Each Cell2 In rngIDs
            If Len(Cell2.Value) = 6 Then
                Cell2.Value = Left(Cell2.Value, 1) * 10000 + Right(Cell2.Value, 4)
            End If
        Next Cell2
    End If
ws_exit:
    Application.EnableEvents = True
End Sub

What am I doing wrong?

 

[bomberman411]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngProper, rngNum, Cell1, Cell2 As Range
On Error GoTo ws_exit:
    Set rngNum = Range("D10:D10000")
    Set rngProper = Range("B10:B10000,C10:C10000")
    Application.EnableEvents = False
    If Not Intersect(rngProper, Target) Is Nothing Then
        For Each Cell1 In rngProper
            Cell1.Value = WorksheetFunction.Proper(Cell1.Value)
        Next Cell1
    End If
    If Not Intersect(rngNum, Target) Is Nothing Then
        For Each Cell2 In rngNum
            If Len(Cell2.Value) = 6 Then
                Cell2.Value = Left(Cell2.Value, 1) * 10000 + Right(Cell2.Value, 4)
            End If
        Next Cell2
    End If
ws_exit:
    Application.EnableEvents = True
End Sub

 

[bomberman411]

Thanks to everyone that helped!

I got it working. I used MickG's code as a macro and it worked like a charm!

Sub NumEmp5Digits()
    Dim Rng, Dn As Range
    Set Rng = Range(Range("D10"), Range("D" & Rows.Count).End(xlUp))
        For Each Dn In Rng
            If Len(Dn) = 6 Then
                Dn = Left(Dn, 1) & Right(Dn, 4)
            End If
        Next Dn
End Sub

Thanks again!