Macro To Delete Numbers With Trailing Character

[Howardc]

I have numbers appearing in Col B on sheet Imported data. I would like a macro to delete the numbers with a trailing X for Eg 13030X, 13040X, 13050X, 13060X etc where the value in Col D is zero

Your assistance in this regard is most appreciated

[LalitPandey87]

Try this:






Option Explicit

Sub Lalit_Test()

Dim varData() As Variant
Dim varFinalData() As Variant
Dim rngNumberRange As Range
Dim lngLoop As Long
Dim lngCount As Long

Const strTrailingChar As String = "X" 'change this accordingly
Const strSrcCell As String = "B1" 'change this accordingly
Const strDstCell As String = "G2" 'change this accordingly
Const strSheetName As String = "Sheet1" 'change this accordingly

With ThisWorkbook.Worksheets(strSheetName)
Set rngNumberRange = .Range(strSrcCell)
Set rngNumberRange = rngNumberRange.Resize(.Cells(.Rows.Count, rngNumberRange.Column).End(xlUp).Row)
If rngNumberRange.Rows.Count > 1 Then
Set rngNumberRange = Intersect(rngNumberRange, rngNumberRange.Offset(1))
varData = rngNumberRange.Resize(, 3)
ReDim varFinalData(1 To UBound(varData), 1 To UBound(varData, 2))
lngCount = 0
For lngLoop = LBound(varData) To UBound(varData)
If Right(LCase(varData(lngLoop, 1)), Len(strTrailingChar)) = LCase(strTrailingChar) Then
If varData(lngLoop, 3) <> 0 Then
lngCount = lngCount + 1
varFinalData(lngCount, 1) = varData(lngLoop, 1)
varFinalData(lngCount, 2) = varData(lngLoop, 2)
varFinalData(lngCount, 3) = varData(lngLoop, 3)
End If
Else
lngCount = lngCount + 1
varFinalData(lngCount, 1) = varData(lngLoop, 1)
varFinalData(lngCount, 2) = varData(lngLoop, 2)
varFinalData(lngCount, 3) = varData(lngLoop, 3)
End If
Next lngLoop
Set rngNumberRange = .Range(strDstCell)
rngNumberRange.Resize(, UBound(varFinalData, 2)).EntireColumn.ClearContents
Set rngNumberRange = rngNumberRange.Resize(UBound(varFinalData), UBound(varFinalData, 2))
rngNumberRange.Value = varFinalData
rngNumberRange.EntireColumn.AutoFit
End If
End With

Erase varData
Erase varFinalData
Set rngNumberRange = Nothing
lngLoop = Empty
lngCount = Empty

End Sub




:cheers:

[Howardc]

Thanks for the reply and your help

The rows containing a trailing X in Col B and where the value in Col D based in the account number ending in an X is not being deleted.

I have attached a sample file with very little data to show you what I want to achieve , indicating which rows to be deleted i.e trailing X + where the value containing the trailing X is zero.

Kindly amend your code accordingly

[Admin]

Hi

another option..


Option Explicit

Sub kTest()

Dim b As String, d As String

Const TrailingChar = "x" 'adjust the char
Const SpeclChar = "####"

With Intersect(ActiveSheet.UsedRange, Range("a:d"))
b = .Columns(2).Address
d = .Columns(4).Address
On Error Resume Next
.Columns(2).SpecialCells(4) = SpeclChar
.Columns(2) = Evaluate("if(" & d & "<>0,if(right(" & b & ",len(""" & TrailingChar & """))=""" & TrailingChar & """,left(" & b & ",len(" & b & ")-len(""" & TrailingChar & """))," & b & ")," & b & ")")
.Columns(2).Replace SpeclChar, vbNullString, 1
End With

End Sub

[Howardc]

Thanks for the help. The rows containing the numbers with the trailing X in Col B where the value in Col D is zero has not been deleted when activating the macro

Your asistance in resolving this will be most appreciated

I have attached the sample data

[Admin]

Hi

I assume your sheet has data in Col A through Col D (at least one cell in each col) , otherwise my code won't work.


Sub kTest()

Dim b As String, d As String

Const TrailingChar = "x" 'adjust the char
Const BlankChar = "####"
Const DeleChar = "||||"

Application.ScreenUpdating = False

With Intersect(ActiveSheet.UsedRange, Range("a:d"))
b = .Columns(2).Address
d = .Columns(4).Address
On Error Resume Next
.Columns(2).SpecialCells(4) = BlankChar
.Columns(2) = Evaluate("if(" & d & "=0,if(right(" & b & ",len(""" & TrailingChar & """))=""" & TrailingChar & """,""" & DeleChar & """," & b & ")," & b & ")")
.Columns(2).Replace DeleChar, vbNullString, 1
.Columns(2).SpecialCells(4).EntireRow.Delete
.Columns(2).Replace BlankChar, vbNullString, 1
End With

Application.ScreenUpdating = True

End Sub

[Howardc]

Thanks for the help, much appreciated

When runnning the macro, I leaves a blank in one of the cells in Col B which had a trailing X-see example attached which contains yiour macro

It would be appreciated if you would correct this

[Admin]

Hi

add this line
.ClearFormats after line
On Error Resume Next

Note: Clear Formats under Home > Clear will remove the trailing apostrophe

[Howardc]

thanks for the help, much appreciated