Macro to truncate string... like "Len,Left,Right formulas"

I would like a macro to identify the cell to the right, shorten the string of text and place it in the active cell. I want to snip characters off both the left and right sides.

I would like a macro to perform as follows:

Run macro

Input box: "Enter the number of characters to delete from the left"

**I'll enter... say "7"

Input box: "Enter the number of characters to delete from the right"

**I'll enter... say "4"

**Then in the active cell it will produce a truncated string.

Any help appreciated!!

Hello Xx7,

Will the macro always perform both the left and right truncations together or separately?

Hello Xx7,

Perhaps this macro will work for what you want to do.

Sub Truncate()

  Dim Lcount As Integer
  Dim NewText As String
  Dim Rcount As Integer
  Dim Response As Variant
  Dim Text As String
  
    Response = InputBox("Enter the number of characters to remove from the left.")
      Lcount = Val(Response)
      
      If Lcount = 0 Then Exit Sub
    
    Response = InputBox("Enter the number of characters to remove from the right.")
      Rcount = Val(Response)
      
      If Rcount = 0 Then Exit Sub
      
    Text = ActiveCell.Text
    
      If Text <> "" Then
         NewText = Mid(Text, Lcount + 1, Len(Text) - Lcount)
         NewText = Mid(NewText, 1, Len(NewText) - Rcount)
      End If
      
    ActiveCell.Offset(0, 1).Value = NewText
    
End Sub

Hello Xx7,

This will ask you to select the range of cells to truncate.

Sub TruncateRange()

  Dim Cell As Range
  Dim Lcount As Integer
  Dim Rng As Range
  Dim NewText As String
  Dim Rcount As Integer
  Dim Response As Variant
  Dim Text As String
  
    Response = InputBox("Enter the number of characters to remove from the left.")
      Lcount = Val(Response)
      
      If Lcount = 0 Then Exit Sub
    
    Response = InputBox("Enter the number of characters to remove from the right.")
      Rcount = Val(Response)
      
      If Rcount = 0 Then Exit Sub
      
    On Error Resume Next
      Set Rng = Application.InputBox("Select the cells you want to truncate.", Type:=8)
      If Err <> 0 Then Exit Sub
      
      For Each Cell In Rng
        Text = Cell.Text
    
        If Text <> "" Then
           NewText = Mid(Text, Lcount + 1, Len(Text) - Lcount)
           NewText = Mid(NewText, 1, Len(NewText) - Rcount)
        End If
      
       Cell.Offset(0, 1).Value = NewText
    
      Next Cell
      
End Sub