Seach for string in all colums and sheet and delete row(s) is perfect match

[piddy]

Hi

I hope you can help me. The following macro works but it also deletes columms that partly contains the string its searching for.

'Sub Remove_columns()
'    Dim wS As Worksheet
'    For Each wS In ThisWorkbook.Worksheets
'        With wS
'            For i = .Columns.Count To 1 Step -1
'                If InStr(1, LCase(.Cells(1, i)), LCase("Cprnr")) Then .Columns(i).EntireColumn.Delete
'                If InStr(1, LCase(.Cells(1, i)), LCase("Cvrnr")) Then .Columns(i).EntireColumn.Delete
'                If InStr(1, LCase(.Cells(1, i)), LCase("Navn")) Then .Columns(i).EntireColumn.Delete
'            Next i
'        End With 'wS
'    Next wS
'End Sub

So if a columm is called procesnavn it also deletes the columm. How can I alter the macro so it only deletes a columms if it's a 100 % match?

Thanks in advanced.

Kind regards
Thomas

 

[piddy]

Hi again

I got the following to work but I have a slight problem:

Sub Remove_columns_test()
    Dim wS As Worksheet
    For Each wS In ThisWorkbook.Worksheets
        With wS
            For i = .Columns.Count To 1 Step -1
                If Cells(1, i).Value = "Cprnr" Then .Columns(i).EntireColumn.Delete
                If Cells(1, i).Value = "Cvrnr" Then .Columns(i).EntireColumn.Delete
                If Cells(1, i).Value = "Navn" Then .Columns(i).EntireColumn.Delete
            Next i
        End With
    Next wS
End Sub

If I run the macro in a sheet where "Navn" is present it works fine, but if I jump to another sheet with non of the key words the macro donsn't delete the rows in the sheet I just left. So I guess it somehow only looks in the active sheet instead of all the sheets.

I hope someone can see the error.

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub Remove_columns_test()
  Dim WS As Worksheet, V As Variant
  For Each WS In ThisWorkbook.Worksheets
    For Each V In Array("Cprnr", "Cvrnr", "Navn")
      WS.UsedRange.Replace V, "#N/A", xlWhole, , False, , False, False
      On Error Resume Next
      Intersect(WS.UsedRange.SpecialCells(xlConstants, xlErrors).EntireColumn, WS.UsedRange).Delete
      On Error GoTo 0
    Next
  Next WS
End Sub[/td]
[/tr]
[/table]

 

[piddy]

Hi Rick

Thank for the solution.
I just tried it but it only deletes the row with "Cprnr" in the header.
For "navn" and "cprnr" it doesn't delete the columms but writes "I/T" "I/T2" in the header.

 

[Rick Rothstein]

It may have to do with locale settings. What happens if you put this formula in a cell...

=NA()

 

[piddy]

It returns : #NAVN ?

 

[Rick Rothstein]

It returns : #NAVN ?

Okay, then in the code I posted in Message #3 , change this line of code...

WS.UsedRange.Replace V, "#N/A", xlWhole, , False, , False, False

to this

WS.UsedRange.Replace V, "#NAVN", xlWhole, , False, , False, False

and then see if it works.

 

[piddy]

Now it just writes #NAVN and the columms still exist.
I can see my title isn't correct. It's the columm which should be deleted if the header contains the search words.

 

[piddy]

Hi Rick

I got the following working now:

In a module:

Sub Remove_GDPR()
Dim a As Long, w As Long, vdelcols As Variant, vcolndx As Variant
vdelcols = Array("Cprnr", "Cvrnr", "Navn")
With ThisWorkbook
    For w = 1 To .Worksheets.Count
        With Worksheets(w)
            For a = LBound(vdelcols) To UBound(vdelcols)
                vcolndx = Application.Match(vdelcols(a), .Rows(1), 0)
                If Not IsError(vcolndx) Then
                    .Columns(vcolndx).EntireColumn.Delete
                End If
            Next a
        End With
    Next w
End With
End Sub

If File is saved the following is run in Thisworkbook:

Option Explicit
 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     Static bolInProcess As Boolean

     Call Remove_GDPR

 MsgBox "File is not saved without personal information"
 End Sub

The Msgbox now comes up every time I click save. Is there a way to code it so it only comes up when the "Remove_GDPR" macro has been run?

I have an alternativ macro for the removal of the columns (see below) and it feels faster than the one above but I get an error "Run-time error '13': Type Mismatch".
Can you see what's wrong?

Sub Remove_columns()
    Dim wS As Worksheet
    For Each wS In ThisWorkbook.Worksheets
        With wS
            For i = .Columns.Count To 1 Step -1
                
                If LCase(Cells(1, i)) = LCase("Cprnr") Then .Columns(i).EntireColumn.Delete
                If LCase(Cells(1, i)) = LCase("Cvrnr") Then .Columns(i).EntireColumn.Delete
                If LCase(Cells(1, i)) = LCase("Navn") Then .Columns(i).EntireColumn.Delete
                    
            Next i
        End With
    Next wS
    
End Sub

 

[piddy]

Please can anyone help with above?