Split based on column header macro

[doriannjeshi]

Hi,
I have this macro that I need to make an adjustement to it
instead of having a fixed column Field:=16 , I need it to split the column based on the header name "example"

 Dim sht As Variant
  
  Application.ScreenUpdating = False
 With ActiveSheet '<- Change sheet name if required
    For Each sht In Split("APL|FR|HRE", "|")
      .Copy After:=Sheets(.Index)
      With ActiveSheet
        .Name = sht
        With .UsedRange
          .AutoFilter Field:=16, Criteria1:="<>" & sht
          .Offset(1).EntireRow.Delete
          .AutoFilter
        End With
      End With
    Next sht
    .Activate
  End With
  Application.ScreenUpdating = True
  
End Sub

 

[Micron]

maybe like this

ColNum = Application.WorksheetFunction.Match("Employee ID", CWS.Rows(1), 0)

taken from here

Find Column Header By Name And Select All Data Below Column Header (Excel-VBA)

I'm attempting to create a macro to do the following: Search a spreadsheet column header by name. Select all data from the selected column, except column header. Take Number Stored As Text & C...

stackoverflow.com

but you would replace Employee ID with the header name you want to look for.
Then this
Field:=16 would become Field:=ColNum

 

[doriannjeshi]

Thank you Micron for the guide
I don't know exactly how to make use of it

 

[Micron]

Please post the code as you have edited it. Pictures are of little use - I can't see what you did.
Have to go to an appt. & will have to look at your reply later.

 

[doriannjeshi]

I tried to add it on top

Sub Shperndadiv()

'shpernda div
   Dim sht As Variant
   Application.ScreenUpdating = False
  ColNum = Application.WorksheetFunction.Match("div", CWS.Rows(1), 0)
  
 With ActiveSheet '<- Change sheet name if required
    For Each sht In Split("APL|FR|HAd", "|")
      .Copy After:=Sheets(.Index)
      With ActiveSheet
        .Name = sht
        With .UsedRange
          .AutoFilter ColNum, Criteria1:="<>" & sht
          .Offset(1).EntireRow.Delete
          .AutoFilter
        End With
      End With
    Next sht
    .Activate
  End With
  Application.ScreenUpdating = True
  
End Sub

 

[Micron]

Did you look at the accepted answer in the linked page? CWS is declared as a sheet object. Either refer to the Activesheet or to an actual sheet name or assign the sheet name to a variable. If you're still stuck after looking at the linked code or that explanation doesn't help, explain if the active sheet is a sheet in the looped array that you have or not. If not, best to use the actual sheet name whenever possible. If you manage to run that code when some other sheet is active, it can have bad results on that sheet.

 

[Micron]

Maybe this way ( I took the liberty of fixing indentation alignment). Look for my notes in the code. Try this on a copy of your wb.
I'm assuming that when the code runs the active sheet is not one of those in the array. I gave it a name that you will have to change in the code. The ActiveSheet reference that comes after that is, I suppose, the sheet that was just copied so I left it as is.
EDIT - if you alter application settings and the code fails and exits you will leave those settings as is if the code doesn't make it to the point where you put them back as they were. It is why I'd always use an error handling routine if temporarily changing app or wb settings.

Sub Shperndadiv()

'shpernda div
Dim sht As Variant
Dim sht1 As Worksheet
Dim ColNum As Long

On Error GoTo errHandler

Application.ScreenUpdating = False
Set sht1 = Sheets("NameOfMySheetGoesHere") 'use the sheet name that applies to ActiveSheet
ColNum = Application.WorksheetFunction.Match("div", sht1.rows(1), 0)
 
With sht1
    For Each sht In Split("APL|FR|HAd", "|")
        .Copy After:=Sheets(.Index)
        With ActiveSheet
            .Name = sht 'I think I'd use sht.name here, not just sht
            With .UsedRange 'Note - used range includes formulas even if they produce no value
                .AutoFilter ColNum, Criteria1:="<>" & sht
                .Offset(1).EntireRow.Delete
                .AutoFilter
            End With
        End With
    Next sht
    .Activate
End With

exitHere:
Application.ScreenUpdating = True
Set sht1 = Nothing
Exit Sub

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere
 
End Sub

 

[doriannjeshi]

Hi Micron,
Thank you for the meticulous explanation

I am running into this error , maybe I am doing sth wrong

Sub ShperndadivIZIONET()

'shpernda div
Dim sht As Variant
Dim sht1 As Worksheet
Dim ColNum As Long

On Error GoTo errHandler

Application.ScreenUpdating = False
Set sht1 = Sheets("SHEET1") 'use the sheet name that applies to ActiveSheet
ColNum = Application.WorksheetFunction.Match("DIV", sht1.Rows(1), 0)
 
With sht1
    For Each sht In Split("APP|FT|HAD", "|")
        .Copy After:=Sheets(.Index)
        With ActiveSheet
            .Name = sht 'I think I'd use sht.name here, not just sht
            With .UsedRange 'Note - used range includes formulas even if they produce no value
                .AutoFilter ColNum, Criteria1:="<>" & sht
                .Offset(1).EntireRow.Delete
                .AutoFilter
            End With
        End With
    Next sht
    .Activate
End With

exitHere:
Application.ScreenUpdating = True
Set sht1 = Nothing
Exit Sub

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere
 
End Sub

<ayb

 

[Micron]

Does row 1 contain the value you're trying to match? If not l can raise that error also. If there is a chance that the value being searched cannot be found on a routine basis then you need to trap the error, or wrap the Match part in IsError function. A better method might be to use Find rather than using worksheet functions in code. I confess that I got the idea of Match from researching this. Will play around with using Match and Find.

 

[Micron]

This version still uses Match because I wanted to learn how to deal with the error it raises, and methods posted elsewhere didn't work so I ended up with the code that follows. First it attempts to match the value. If it doesn't you get a message and code exits. What I don't like about it is that the match function has to be used 2x so there is the potential to change one line and not the other. Also, 1004 error is one that has many causes thus I don't like trapping it based on number. Perhaps it would be marginally better if code could trap based on the message text. It would be better (if sticking with Match) to pass the searched value to the sub as a parameter and use the parameter variable instead of "div" or any string that you're trying to match on. That would look like
Sub Shperndadiv(str As String)
and the call would be
Sub Shperndadiv("div")
and you would use the variable str in code and not "div"

Anyway, I think it would probably better to us Find in vba but you can see if this works or not. I can't test the loop without those sheets and/or their data.

Sub Shperndadiv()

'shpernda div
Dim sht As Variant, resp As Variant
Dim sht1 As Worksheet
Dim ColNum As Long

On Error GoTo errHandler
Set sht1 = Sheets("Sheet1") 'use the sheet name that applies to ActiveSheet
resp = IsError(Application.WorksheetFunction.Match("div", sht1.rows(1), 0))
If Not resp = True Then
    On Error GoTo errHandler
    Application.ScreenUpdating = False
    Set sht1 = Sheets("Sheet1") 'use the sheet name that applies to ActiveSheet
    ColNum = Application.Match("div", sht1.rows(1), 0) 'this 'div' value must match the value used above
    With sht1
        For Each sht In Split("APL|FR|HAd", "|")
            .Copy After:=Sheets(.Index)
            With ActiveSheet
                .Name = sht 'I think I'd use sht.name here, not just sht
                With .UsedRange 'Note - used range includes formulas even if they produce no value
                    .AutoFilter ColNum, Criteria1:="<>" & sht
                    .Offset(1).EntireRow.Delete
                    .AutoFilter
                End With
            End With
        Next sht
        .Activate
    End With
Else
    MsgBox "Value used for Match was not found."
End If

exitHere:
Application.ScreenUpdating = True
Set sht1 = Nothing
Exit Sub

errHandler:
If Err.Number = 1004 Then
    resp = True
    Resume Next
Else
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume exitHere
End If

End Sub