Remove column that has second occurrence of header name

zemko

New Member
Joined
Nov 3, 2016
Messages
4
Hi,

I have code, when I reduce number of columns, I need only columns matching header name. The problem is that in the data source (SAP report) are twice.

So I count the number of occurrences and for one case I am able to delete the second column as this occurrence is always on second column but in the second case there is problem that in one report it is in column G and in month earlier it is in column F (not sure how this happened). So I need to determine the position of second column and this delete this column

The headers after first part looks like this (the problematic part is in bold)
Debits indicator Description Determination characteristic result line Description G/L Account Amount Determination characteristic result line

or like this
Debits indicator Description Determination characteristic result line Description G/L Account Determination characteristic result line Amount


VBA Code:
 lcol = Cells(1, columns.Count).End(xlToLeft).Column 

'removes all columns not matching the case, starting from end
    For delcol = lcol To 1 Step -1
        Select Case Cells(1, delcol)
        Case "Debits indicator", "Determination characteristic result line", "Description", "G/L Account", "Amount"
        'will do nothing if the value is matched
        Case Else
        columns(delcol).Delete
        End Select
    Next
    

CountDesc = Application.CountIf(Range("A1:Z1"), "Description")
CountDete = Application.CountIf(Range("A1:Z1"), "Determination characteristic result line")
    
    If CountDesc > 1 Then
        Range("B:B").Select
        Selection.Delete Shift:=xlToLeft 'delete first Description column in column B
    End If
    
    If CountDete > 1 Then
'TBD - there should be the check for Deterministic characteristic result line header
    End If

Is there any way to do this? to determine the address of second occurrence of the case and delete the whole column?

Thank you very much.
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
It may not be the fastest, but should do the work. Variables should be self explanatory
VBA Code:
Sub del_col()
Dim last_col As Long, header_row As Long, j As Long, search_for As String
header_row = 1
last_col = Cells(Header.Row, Columns.Count).End(xlToLeft).Column

search_for = "Determination characteristic result line"

'search for first occurance
For j = 1 To last_col
   If Cells(header_row, j) = search_for Then
      'do something with what you cound
      Columns(j).Delete
      Exit For 'to ensure only one column deletion
   End If
Next j

End Sub
Or reverse (warning: this search for last column occurrence, not second occurrence)
VBA Code:
Sub del_col_rev()
Dim last_col As Long, header_row As Long, j As Long, search_for As String
header_row = 1
last_col = Cells(Header.Row, Columns.Count).End(xlToLeft).Column

search_for = "Determination characteristic result line"

'search for last occurance
For j = last_col To 1 Step -1
   If Cells(header_row, j) = search_for Then
      'do something with what you cound
      Columns(j).Delete
      Exit For 'to ensure only one column deletion
   End If
Next j

End Sub
 
Upvote 0
It may not be the fastest, but should do the work. Variables should be self explanatory

Thank you very much, the latter works like a charm. As I have currently only two occurrences, it works when the search_for is after the column I want to stay.

Maybe one question, how to remove all occurrences for search_for except the first one? Commenting the Exit For will delete all occurrences of search_for.
 
Upvote 0
Commenting the Exit For will delete all occurrences of search_for.
'Exit For' causes to stop deleting after first found occurrence. But removing it completely will cause to delete all occurrences.

Removing all but first is a bit complicated. First we will read all columns numbers to array, and then delete all but first
VBA Code:
Sub del_col_except_first()
Dim last_col As Long, header_row As Long, j As Long, search_for As String
header_row = 1
last_col = Cells(header_row, Columns.Count).End(xlToLeft).Column

search_for = "Determination characteristic result line"

Dim col_to_del() As Long
ReDim col_to_del(0)

Dim i As Long
i = 0

'search for all occurrences and saving it to array
For j = 1 To last_col
   If Cells(header_row, j) = search_for Then
      If col_to_del(0) <> 0 Then
         ReDim Preserve col_to_del(UBound(col_to_del) + 1)
      End If
      col_to_del(i) = j
      i = i + 1
   End If
Next j

If UBound(col_to_del) > 0 Then 'if array is bigger than one element - delete all but first
   For i = LBound(col_to_del) + 1 To UBound(col_to_del) '+1 skips first occurrence
      Columns(i).Delete
   Next i
End If

Debug.Print "Only one column with this header found. Column is: " & Split(Cells(1, col_to_del(0)).Address, "$")(1)
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,198
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top