This code to run over multiple columns

[Pumper]

Hi All, I have this code that Peter_SSs kindly provided that works perfectly.

I would like to expand this code to run over each column if row 1 in that column has something in it.

So once it has run over column A move on to column B etc until there is nothing in row 1 of whatever column that may be.

Have tried to get this to work via a loop but no bueno, here is the code that works on column A

Any assistance would be much appreciated

Sub Remove_Based_on_Right9()
Sheets("Sheet1").Select
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    .Value = Evaluate(Replace("if(isnumber(match(""*""&left(right(#,9),1)&""*"",A1,0)),#,0)", "#", .Address))
    On Error Resume Next
    .SpecialCells(xlConstants, xlNumbers).Delete Shift:=xlUp
    On Error GoTo 0
  End With
End Sub

 

[kvsrinivasamurthy]

TRy

Sub Remove_Based_on_Right9()
Dim Clms&, T&, k
Dim Rng As Range
Sheets("Sheet1").Select
Set Rng = Range("A2:F" & Range("A" & Rows.Count).End(xlUp).Row) 'Select the column(here itis F) as required
Clms = Rng.Columns.Count
  
  With Rng
  For T = 1 To Clms
    With .Columns(T)
    k = .Cells(1, 1)
    .Value = Evaluate(Replace("if(isnumber(match(""*""&left(right(#,9),1)&""*"",k,0)),#,0)", "#", .Address))
    On Error Resume Next
    .SpecialCells(xlConstants, xlNumbers).Delete Shift:=xlUp
    On Error GoTo 0
    End With
  Next T
  End With
End Sub

 

[kvsrinivasamurthy]

Code modified

Sub Remove_Based_on_Right9()
Dim Clms&, T&, k
Dim Rng As Range
Sheets("Sheet1").Select
Set Rng = Range("A2:F" & Range("A" & Rows.Count).End(xlUp).Row) 'Select the column(here itis F) as required
Clms = Rng.Columns.Count
  
  With Rng
  For T = 1 To Clms
    With .Columns(T)
    k = .Cells(1, 1)
        If k <> "" Then
        .Value = Evaluate(Replace("if(isnumber(match(""*""&left(right(#,9),1)&""*"",k,0)),#,0)", "#", .Address))
        On Error Resume Next
        .SpecialCells(xlConstants, xlNumbers).Delete Shift:=xlUp
        On Error GoTo 0
        End If
    End With
  Next T
  End With
End Sub

 

[Pumper]

Code modified

Sub Remove_Based_on_Right9()
Dim Clms&, T&, k
Dim Rng As Range
Sheets("Sheet1").Select
Set Rng = Range("A2:F" & Range("A" & Rows.Count).End(xlUp).Row) 'Select the column(here itis F) as required
Clms = Rng.Columns.Count
 
  With Rng
  For T = 1 To Clms
    With .Columns(T)
    k = .Cells(1, 1)
        If k <> "" Then
        .Value = Evaluate(Replace("if(isnumber(match(""*""&left(right(#,9),1)&""*"",k,0)),#,0)", "#", .Address))
        On Error Resume Next
        .SpecialCells(xlConstants, xlNumbers).Delete Shift:=xlUp
        On Error GoTo 0
        End If
    End With
  Next T
  End With
End Sub

Thanks for taking the time to look at this kvsrinivasamurthy

It runs but not giving the correct results unfortunately, some columns returning nothing others returning some values but not correct.

 

[kvsrinivasamurthy]

Sorry I thought first cell of range. Actually it is first cell of that column. Code Modified . Pl Try now.
If Problem is there Explain What is the problem.

Sub Remove_Based_on_Right9()
Dim Clms&, T&, k
Dim Rng As Range
'Sheets("Sheet1").Select
Set Rng = Range("A2:F" & Range("A" & Rows.Count).End(xlUp).Row) 'Select the column(here itis F) as required
Clms = Rng.Columns.Count
  
  With Rng
  For T = 1 To Clms
    With .Columns(T)
    k = Cells(1, T)
        If k <> "" Then
        .Value = Evaluate(Replace("if(isnumber(match(""*""&left(right(#,9),1)&""*"",k,0)),#,0)", "#", .Address))
        On Error Resume Next
        .SpecialCells(xlConstants, xlNumbers).Delete Shift:=xlUp
        On Error GoTo 0
        End If
    End With
  Next T
  End With
End Sub

 

[Pumper]

Sorry I thought first cell of range. Actually it is first cell of that column. Code Modified . Pl Try now.
If Problem is there Explain What is the problem.

Sub Remove_Based_on_Right9()
Dim Clms&, T&, k
Dim Rng As Range
'Sheets("Sheet1").Select
Set Rng = Range("A2:F" & Range("A" & Rows.Count).End(xlUp).Row) 'Select the column(here itis F) as required
Clms = Rng.Columns.Count
 
  With Rng
  For T = 1 To Clms
    With .Columns(T)
    k = Cells(1, T)
        If k <> "" Then
        .Value = Evaluate(Replace("if(isnumber(match(""*""&left(right(#,9),1)&""*"",k,0)),#,0)", "#", .Address))
        On Error Resume Next
        .SpecialCells(xlConstants, xlNumbers).Delete Shift:=xlUp
        On Error GoTo 0
        End If
    End With
  Next T
  End With
End Sub

Thanks again!

Tried this but still giving wrong results for example column A returns blanks when it shouldn't, Column B appears correct, column D returned 2 when should have been more...

Hopefully i am being clear here, this would work but trying to avoid doing like this obviously

Sub Remove_Based_on_Right9_A()
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    .Value = Evaluate(Replace("if(isnumber(match(""*""&left(right(#,9),1)&""*"",A1,0)),#,0)", "#", .Address))
    On Error Resume Next
    .SpecialCells(xlConstants, xlNumbers).Delete Shift:=xlUp
    On Error GoTo 0
  End With
End Sub

then

Sub Remove_Based_on_Right9_B()
  With Range("B2", Range("B" & Rows.Count).End(xlUp))
    .Value = Evaluate(Replace("if(isnumber(match(""*""&left(right(#,9),1)&""*"",B1,0)),#,0)", "#", .Address))
    On Error Resume Next
    .SpecialCells(xlConstants, xlNumbers).Delete Shift:=xlUp
    On Error GoTo 0
  End With
End Sub

 

[jolivanes]

If you explain what you want to achieve without showing code that does not work for you, what would your question be?
Peter has supplied you with code that you don't understand and therefor are unable to change.

 

[Pumper]

If you explain what you want to achieve without showing code that does not work for you, what would your question be?
Peter has supplied you with code that you don't understand and therefor are unable to change.

Not sure the point of your msg.

I also don't understand how computers work but I am using one at the moment.

I showed two sets of code above (yes Peter supplied) and was after help on how to link them without having keep writing almost the same thing for each column.

If my post annoyed you, don't waste your time responding.

 

[kvsrinivasamurthy]

Is it possible to upload a sample file with expected results.

 

[Pumper]

Is it possible to upload a sample file with expected results.

A small example would be like this

Original Data

After Macro (deleted the last from each column in this case as the letter X (9 from the left) is not in the corresponding row A

So if the letter 9th from the left from row 2 and below is not in row A in that column it needs to be deleted.