Extract value into columns using VBA

[Vincent88]

Hi Guys,
I want to create a code to split the content of a cell into 3 colurmns but it does not work out. Please help to make it through.

What the code should do is to convert the those numbers in the left to MAC address and put it into column B, and those numbers after "X=" and "Y=" to column C and D respectively.

Here is my unfinished code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myText As String
Dim macText As String
Dim c As Range
Dim lrow As Long
Dim EntryMac As Long
Dim EntryX As Long
Dim EntryY As Long


lrow = Range("A1").End(xlDown).Row

If Target.CountLarge > 1 Then Exit Sub
On Error GoTo ErrHandler:


    If Len(Target) < 12 Then Exit Sub  'check for correct length
    If Target.Column <> 1 And Target.Row = 1 Then Exit Sub 'only Column A and Row 2 downwards
    If Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
    
    If Not Intersect(Target, Range("A2:A" & lrow)) Is Nothing Then
    
    For Each c In Range("b2:b" & lrow)
        
         macText = Left(Target.Value, 12)
         myText = Left(macText.Value, 2) _
        & "-" & Mid(macText.Value, 3, 2) _
        & "-" & Mid(macText.Value, 5, 2) _
        & "-" & Mid(macText.Value, 7, 2) _
        & "-" & Mid(macText.Value, 9, 2) _
        & "-" & Right(macText.Value, 2)
      
    EntryMac = Left(Target, 12)
    EntryX = InStr(Target, "X=" - InStr(Target, "Y="))
    EntryY = InStr(Target, "Y=")
          c.Value = UCase(myText)
        
    
    mcell.Value = macText
    
    Next c
  
    
    Application.EnableEvents = True
End Sub

 

[Alex Blakenburg]

See if this does what you need:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lrow As Long
    Dim arr As Variant
    
    lrow = Range("A1").End(xlDown).Row
   
    If Target.CountLarge > 1 Then Exit Sub

    If Len(Target) < 12 Then Exit Sub  'check for correct length
   
    ' XXX Changed next line, since either not column A OR row 1 should cause it to exit
    If Target.Column <> 1 Or Target.Row = 1 Then Exit Sub 'only Column A and Row 2 downwards
   
    If Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
   
    If Not Intersect(Target, Range("A2:A" & lrow)) Is Nothing Then

        arr = Split(Application.Trim(Target), " ")
        Target.Offset(0, 1) = Format(arr(0), "00-00-00-00-00-00")
        Target.Offset(0, 2) = Mid(arr(1), 3, Len(arr(1)) - 2)
        Target.Offset(0, 3) = Mid(arr(2), 3, Len(arr(1)) - 2)
 
    End If
   
    Application.EnableEvents = True
End Sub

 

[Joe4]

Do you really need VBA?
This can be done pretty easily with formulas, i.e.

B2 formula:

=LEFT(A2,FIND(" ",A2)-1)

C2 formula:

=TRIM(MID(A2,FIND("X=",A2)+2,4))

D2 formula:

=TRIM(MID(A2,FIND("Y=",A2)+2,4))

 

[Vincent88]

See if this does what you need:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lrow As Long
    Dim arr As Variant
  
    lrow = Range("A1").End(xlDown).Row
 
    If Target.CountLarge > 1 Then Exit Sub

    If Len(Target) < 12 Then Exit Sub  'check for correct length
 
    ' XXX Changed next line, since either not column A OR row 1 should cause it to exit
    If Target.Column <> 1 Or Target.Row = 1 Then Exit Sub 'only Column A and Row 2 downwards
 
    If Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
 
    If Not Intersect(Target, Range("A2:A" & lrow)) Is Nothing Then

        arr = Split(Application.Trim(Target), " ")
        Target.Offset(0, 1) = Format(arr(0), "00-00-00-00-00-00")
        Target.Offset(0, 2) = Mid(arr(1), 3, Len(arr(1)) - 2)
        Target.Offset(0, 3) = Mid(arr(2), 3, Len(arr(1)) - 2)
 
    End If
 
    Application.EnableEvents = True
End Sub

Hi, the arr(0) output does not show with hypen in between the figures
View attachment 60323
also I added UCASE to the code to make output in capital letters : Target.Offset(0, 1) = UCase(Format(arr(0), "00-00-00-00-00-00"))

 

[Vincent88]

Do you really need VBA?
This can be done pretty easily with formulas, i.e.

B2 formula:

=LEFT(A2,FIND(" ",A2)-1)

C2 formula:

=TRIM(MID(A2,FIND("X=",A2)+2,4))

D2 formula:

=TRIM(MID(A2,FIND("Y=",A2)+2,4))

Hi Joe4,
I prefer VBA method better. Thanks

 

[Joe4]

Hi Joe4,
I prefer VBA method better. Thanks

You could use VBA to drop those formulas into columns B, C, and D of whatever row you are adding a value to column A in!

 

[Joe4]

That code to put the formulas in the cells upon the updating of column A would look like this:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.CountLarge > 1 Then Exit Sub
    
'   If update is to column A after row 2
    If Target.Column = 1 And Target.Row > 1 Then
        Application.EnableEvents = False
        Range("B" & Target.Row).FormulaR1C1 = "=LEFT(RC[-1],FIND("" "",RC[-1])-1)"
        Range("C" & Target.Row).FormulaR1C1 = "=TRIM(MID(RC[-2],FIND(""X="",RC[-2])+2,4))"
        Range("D" & Target.Row).FormulaR1C1 = "=TRIM(MID(RC[-3],FIND(""Y="",RC[-3])+2,4))"
        Application.EnableEvents = True
    End If
    
End Sub

 

[Rick Rothstein]

Here is another Change event procedure that will also work...

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 And Target.Row > 1 Then Target.TextToColumns Target.Offset(, 1), xlDelimited, , 1, 0, 0, 0, 1, 1, "=", Array(Array(1, 1), Array(2, 9), Array(3, 1), Array(4, 9), Array(5, 1))
End Sub

 

[Alex Blakenburg]

Sadly format text only works on numeric values, here is a modified version.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim macText As String
    Dim lrow As Long
    Dim arr As Variant
    Dim i As Long

    lrow = Range("A1").End(xlDown).Row

    If Target.CountLarge > 1 Then Exit Sub

'   If update is to column A after row 2
    If Target.Column = 1 And Target.Row > 1 Then

        Application.EnableEvents = False

        arr = Split(Application.Trim(Target), " ")

        macText = ""
        For i = 1 To 11 Step 2
            macText = macText & "-" & Mid(arr(0), i, 2)
        Next i

        Target.Offset(0, 1) = Right(UCase(macText), Len(macText) - 1)
        Target.Offset(0, 2) = Mid(arr(1), 3, Len(arr(1)) - 2)
        Target.Offset(0, 3) = Mid(arr(2), 3, Len(arr(1)) - 2)

        Application.EnableEvents = True

    End If

End Sub

 

[Rick Rothstein]

Oh, MAC addresses have dashes in them! I wasn't aware of that. Okay, here is my previously posted event code procedure modified to do that...

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 And Target.Row > 1 Then
    Target.TextToColumns Target.Offset(, 1), xlDelimited, , 1, 0, 0, 0, 1, 1, "=", Array(Array(1, 1), Array(2, 9), Array(3, 1), Array(4, 9), Array(5, 1))
    Target.Offset(, 1) = Format(Target.Offset(, 1), "@@-@@-@@-@@-@@-@@")
  End If
End Sub