CODEWITHSUNDEEP
excelexcel-formulavba
anp93
anp93

Reputation: 41

Removing last 4 characters with vba and replacing the new word/number in the same cell

I think there is probably a very easy solution to this question, but I'm having a lot of trouble finding it and I've only been using/learning VBA for a couple of days now.

I'm trying to use VBA to remove a space and the letters USD after a dollar figure. This occurs in only 3 specific cells in my worksheet and occurs on all subsequent worksheets in my workbook. Right now I'm not worried about looping through the other worksheets.

Below is the code I have found that works if I manually select the cell I want the code to work on, but I would like to tie this to a button so that the process happens without me having to choose the cell. 

Sub RemoveUSD()

Dim Cell As Range, Str As String, StrLen1 As Integer, StrLen2 As Integer
    ' For each cell in your current selection
    For Each Cell In selection
        ' Set StrLen1 as the length of the current cell value
            StrLen1 = Len(Cell.Value)
            ' Set StrLen2 as the original length minus 3
            StrLen2 = StrLen1 - 3
                ' Set Str as the original cell value minus the last 3 characters
                Str = Left(Cell.Value, StrLen2)
        ' Update the adjacent cell with the shortened value
        Cell.Value = Str
     ' Check next cell in selection
    Next Cell

End Sub

Upvotes: 3

Views: 12038

Answers (3)

BNTZ
BNTZ

Reputation: 1

Got a version where you can define on execution which range should be chosen (based on the earlier solution posted):

Sub AdjustTrimRange()
Dim Cell As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "TrimRange"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

For Each Cell In WorkRng

            StrLen1 = Len(Cell.Value)
  ' Set amount to cut at the end of the string:
            StrLen2 = StrLen1 - 3

  ' cell value will be replaced by cell value minus number above,
  ' will trim for spaces at the beginning of the string:
                Cell.Value = Replace(Cell.Value, Cell.Value, Trim(Left(Cell.Value, StrLen2)))
    Next

End Sub

Upvotes: 0

brettdj
brettdj

Reputation: 55692

You can do it directly over a range plus check if

  • the cell is at least four characters, and
  • the last four characters are " USD"

For A1:A30

[a1:A30] = Application.Evaluate("=IF(LEN(A1:A30)>4,IF(RIGHT(A1:A30,4)="" USD"",LEFT(A1:A30,LEN(A1:A30)-4),A1:A30),A1:A30)")

Upvotes: 1

Kyle
Kyle

Reputation: 2545

Just input the workbook name, worksheet name and range you want and this will do it for you. I put the Trim in just to take off any leading or trailing white space. To attached this to a button, add a button (Developer tab > Controls > Insert) and select the macro to attach to it.

Sub RemoveUSD()

Dim Cell As Range, rng as Range 
Dim Str As String
Dim StrLen1 As Integer, StrLen2 As Integer
With Workbooks("Daily MSR VaR Automation Attempt")
    With .Sheets("8-30 copy")
       Set rng = .Range("E2,N2,W2")
    End With
End With
    ' For each cell in your current selection
    For Each Cell In rng
        ' Set StrLen1 as the length of the current cell value
            StrLen1 = Len(Cell.Value)
            ' Set StrLen2 as the original length minus 3
            StrLen2 = StrLen1 - 3
                ' Set Str as the original cell value minus the last 3 characters
                Str = Trim(Left(Cell.Value, StrLen2))
        ' Update the adjacent cell with the shortened value
        Cell.Value = Str
     ' Check next cell in selection
    Next Cell

End Sub

Upvotes: 1

Related Questions