VBA: If satisfying condition on partial match

[Adar123]

I am using the following code to copy data from one cell to another. The challenge I am having is with with the definition of the if condition as a partial match: The cells in column A contain information in the following format: RANDOM_TEXT_25DP.

I need to copy data whenever cell A contains _25DP at the end. How do I do that?

Current code

Sub MoveData()

Dim k As Integer, kMove As Integer
Dim Kcolumn As Long, Ccolumn As Long
Dim refCell As Range, outputCell As Range

Kcolumn = 7                 ' destination
Ccolumn = 6                  ' reference

For k = 2 To 5000
    If Cells(k, 1) = "_25DP" Then
        kMove = k -1
        Set refCell = Cells(k, Ccolumn)
        Set outputCell = Cells(kMove, Kcolumn)
        outputCell.Value = refCell.Value
    End If
Next k

End Sub

 

[Peter_SSs]

Try just changing your 'If' line to this

If Right(Cells(k, 1), 5) = "_25DP" Then

or another option would be

If Cells(k, 1) Like "*_25DP" Then

 

[Adar123]

Ah, something new, didn't know there is "Like"

Confirm. It works and thanks for the solution!

 

[Adar123]

Following this logic of the code with "if like" could I instruct deletion of lines? I tried the code below but I am ening up wiping all data for some reason.

Propose code:

For k = 2 To lastRow
If Cells(k, 1) Like "*_25DP" Then
Rows(k).EntireRow.Delete
End If
Next k

Original code (using autofilter which works but seems to be quite heavy)

With rng
.AutoFilter Field:=1, Criteria1:="=*_5DP*"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
ActiveSheet.AutoFilterMode = False

With rng
.AutoFilter Field:=1, Criteria1:="=*_15DP*"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
ActiveSheet.AutoFilterMode = False

 

[Peter_SSs]

When deleting in a loop like that, best to start at the bottom & work up.
Try

For k = lastRow to 2 step -1

works but seems to be quite heavy

By 'heavy' do you mean slow? If so, here is a much faster way. It assumes the *_25DP values are in column A & there is a header row.

Sub Del_25DP()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) Like "*_25DP" Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[Adar123]

Yes, under 'heavy' I mean slow. In fact, my newly proposed code takes even longer.

Does your proposed code support multiple matches with an OR equivalent? I have 10 parameters to check for. _5DP, 10DP, etc. This will become War and Piece macro if I keep copy-pasting this.

 

[Peter_SSs]

I have 10 parameters to check for. _5DP, 10DP, etc.

Can we see what all the parameters actually are to look for similarities/patterns/lengths etc to consider the best way. I'm fairly confident there will be a fast way.

Any chance that we could also have a small sample (say 10-20 rows) of the data (preferably with XL2BB) that has to be assessed for these parameters so we have something realistic to test with?
Make sure some of the sample include a 'delete parameter' and some don't.

 

[Adar123]

DataSet.csv
	A	B	C
1	Key	Currency	Price
2	W_ROUNDED:FALSE_SEP2020_5DP	USD	0.007461
3	W_ROUNDED:FALSE_SEP2020_10DP	USD	0.015774
4	W_ROUNDED:FALSE_SEP2020_15DP	USD	0.025059
5	C_ROUNDED:FALSE_SEP2020_20DP	USD	0.035233
6	C_ROUNDED:FALSE_SEP2020_25DP	USD	0.046266
7	C_ROUNDED:FALSE_SEP2020_30DP	USD	0.058183
8	C_ROUNDED:FALSE_SEP2020_35DP	USD	0.071341
9	C_ROUNDED:FALSE_SEP2020_40DP	USD	0.086086
10	C_ROUNDED:FALSE_SEP2020_45DP	USD	0.102748
11	C_ROUNDED:FALSE_SEP2020_50DP	USD	0.121778
12	C_ROUNDED:FALSE_SEP2020_ATM	USD	0.114699
13	C_ROUNDED:FALSE_SEP2020_50DC	USD	0.109032
14	C_ROUNDED:FALSE_SEP2020_45DC	USD	0.093831
15	C_ROUNDED:FALSE_SEP2020_40DC	USD	0.080055
DataSet

Thanks, this is the snapshot of a dataset.

I need to delete all but the ones containing _5DP, _40DP and _40DC.

 

[Peter_SSs]

Thanks for the sample data.

I need to delete all but the ones containing _5DP, _40DP and _40DC

OK, try this version for that

Sub Del_Except()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    Select Case Mid(a(i, 1), InStrRev(a(i, 1), "_"))
      Case "_5DP", "_40DP", "_40DC"   '<- Keep these
      Case Else                       '<- Delete everything else
        b(i, 1) = 1
        k = k + 1
    End Select
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[Adar123]

This code is above my skills, based on my test it works. Thanks for that.