1

Trying to make a macro that automatically calls another macro to extract parts of the entered string and insert into two other cells. The splitting macro works when called on a cell manually but cannot get it to trigger automatically.

Sub splitEnvServ()
'
' Macro3 Macro
'

'
Selection.TextToColumns destination:=ActiveCell.Offset(, 2), DataType:=xlDelimited, \_
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, \_
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar \_
\:="/", FieldInfo:=Array(Array(1, 9), Array(2, 9), Array(3, 9), Array(4, 9), Array(5, \_
9), Array(6, 9), Array(7, 9), Array(8, 9), Array(9, 9), Array(10, 9), Array(11, 9), Array(12 \_
, 9), Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(17, 9), Array(18, 9)), \_
TrailingMinusNumbers:=True
End Sub

'
' Part that won't trigger
'
'

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("B13")) Is Nothing Then splitEnvServ
End Sub
  • What does *"cannot get it to trigger automatically"* mean? Is there an error, does Excel freeze, nothing, or something else? Are you trying to split the string in `B13` by a slash (`/`) in to cells `C13:D13`? Why don't you share some sample data as text? You can [edit your post](https://stackoverflow.com/posts/71720828/edit) at any time. – VBasic2008 Apr 03 '22 at 00:33
  • What I mean when someone enters a url like: https://test/test/job/test/job/test/job/test/Deploy/job/ToC13/job/ToD13/458/test It would split the marked sections into C13 and D13 when a url is entered into column B. But nothing happens when this is entered – liam fitzgerald Apr 03 '22 at 10:00

2 Answers2

1

A Worksheet Change: Split Cell to Row

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ClearError
    
    Const cAddress As String = "B13"
    
    Dim iCell As Range: Set iCell = Intersect(Range(cAddress), Target)
    If iCell Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    SplitEnvServ iCell
    
SafeExit:
    On Error Resume Next
        If Not Application.EnableEvents Then Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub

ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub

Sub SplitEnvServ(ByVal Cell As Range)
    
    Const Delimiter As String = "/"
    Const ColumnOffset As Long = 1
    
    With Cell.Offset(, ColumnOffset)
        Dim lCell As Range: Set lCell = .Resize(, Columns.Count - .Column + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If Not lCell Is Nothing Then
            .Resize(, lCell.Column - .Column + 1).ClearContents
        End If
    End With
    
    Dim Sentence As String: Sentence = CStr(Cell.Value)
    If Len(Sentence) = 0 Then Exit Sub
    
    Dim Words() As String: Words = Split(Sentence, Delimiter)
    
    Cell.Offset(, ColumnOffset).Resize(, UBound(Words) + 1).Value = Words
    
End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • Still doesn't seem to work is there some configuration needed to enable it ? The work book is an excel enabled worksheet – liam fitzgerald Apr 05 '22 at 07:30
  • This code needs to be in the sheet module of the worksheet e.g. `Sheet1` where you want to apply this (not `Module1`). It only reflects a manual change in cell `B13`. If you have a formula in it, it won't get triggered. If you have accidentally disabled events use the following line in a new sub: `Application.EnableEvents = True` and run the sub. Feel free to [download my file on Google Drive](https://drive.google.com/file/d/1Xpb8jfIyhfjhCU1XQQLdQ77TxmdADt0B/view?usp=sharing). – VBasic2008 Apr 05 '22 at 07:43
0

In your sub you missing the End if. Try:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("B13")) Is Nothing Then
splitEnvServ
End If
End Sub
Chux
  • 1
  • 2