Convert Recorded Macro to Dynamic Values/Ranges

[zero269]

Hello,

I've recorded a Macro that filters a column by color, and then sorts another column in ascending order.
I'm trying to make this code more dynamic so I can reuse it elsewhere.
I've been playing around with ways to find the active Sheet (ActiveSheet.Name )and active Table (ActiveCell.ListObject.Name) first, and then find the Column Number based on the Column Heading but I can't make sense of the plethora of examples I've seen online.

Ultimately, I'd like to:

• Replace "tblBooks" with Active Table
• Replace "Books" with Active Sheet
• Replace the column number 15 in (Field:=15) with an integer variable that's determined after finding a specified Header value first such as "Book Status" in the case of the following Macro.
• Possibly a variable for the RGB or HEX color values

Recorded Macro:

Sub TestAutoFilter()
    
    'Filter Book Status by color
    ActiveSheet.ListObjects("tblBooks").Range.AutoFilter Field:=15, _
        Criteria1:=RGB(217, 225, 242), Operator:=xlFilterCellColor
    
    'Sort Test Date ascending
    ActiveWorkbook.Worksheets("Books").ListObjects("tblBooks").Sort. _
        SortFields.Clear
    
    ActiveWorkbook.Worksheets("Books").ListObjects("tblBooks").Sort. _
        SortFields.Add2 Key:=Range("tblBooks[[#Headers],[#Data],[Test Date]]"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Books").ListObjects("tblBooks").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

Sample Data
Note: I created this sample data using only two columns...

Book1
	A	B
1	Test Date	Book Status
2	10-Feb	Active
3	10-Feb	Held
4	10-Feb	In Transit
5	09-Feb	Active
6	09-Feb	Held
7	09-Feb	In Transit
8	08-Feb	In Transit
9	07-Feb	Active
10	07-Feb	Held
11	07-Feb	In Transit
12	06-Feb	Active
13	06-Feb	Held
14	03-Feb	Active
15	03-Feb	In Transit
Books

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B2:B15	Expression	=SUM(COUNTIF($B2,cfBookStatus))	text	NO

 

[HaHoBe]

Hi zero269,

what about this for a start:

Public Sub MrE_1229014_170230B()
' https://www.mrexcel.com/board/threads/convert-recorded-macro-to-dynamic-values-ranges.1229014/
  Dim objLO As ListObject
  Dim strSort As String
  Dim varRet As Variant
  
  Const cstrSEARCH As String = "Book Status"
  
  On Error Resume Next
  Set objLO = ActiveCell.ListObject
  Err.Clear
  On Error GoTo 0
  If Not objLO Is Nothing Then
    varRet = Application.Match(cstrSEARCH, objLO.HeaderRowRange, 0)
    If Not IsError(varRet) Then
      With objLO
        strSort = .Name & "[[#Headers],[#Data],[Test Date]]"
        .Range.AutoFilter Field:=varRet, Criteria1:=RGB(217, 225, 242), Operator:=xlFilterCellColor
        With .Sort
          With .SortFields
            .Clear
            .Add2 Key:=Range(strSort), _
                  SortOn:=xlSortOnValues, _
                  Order:=xlAscending, _
                  DataOption:=xlSortNormal
          End With
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .SortMethod = xlPinYin
          .Apply
        End With
      End With
    End If
    Set objLO = Nothing
  End If
End Sub

Ciao,
Holger

 

[zero269]

Hi zero269,

what about this for a start:

Public Sub MrE_1229014_170230B()
' https://www.mrexcel.com/board/threads/convert-recorded-macro-to-dynamic-values-ranges.1229014/
  Dim objLO As ListObject
  Dim strSort As String
  Dim varRet As Variant
 
  Const cstrSEARCH As String = "Book Status"
 
  On Error Resume Next
  Set objLO = ActiveCell.ListObject
  Err.Clear
  On Error GoTo 0
  If Not objLO Is Nothing Then
    varRet = Application.Match(cstrSEARCH, objLO.HeaderRowRange, 0)
    If Not IsError(varRet) Then
      With objLO
        strSort = .Name & "[[#Headers],[#Data],[Test Date]]"
        .Range.AutoFilter Field:=varRet, Criteria1:=RGB(217, 225, 242), Operator:=xlFilterCellColor
        With .Sort
          With .SortFields
            .Clear
            .Add2 Key:=Range(strSort), _
                  SortOn:=xlSortOnValues, _
                  Order:=xlAscending, _
                  DataOption:=xlSortNormal
          End With
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .SortMethod = xlPinYin
          .Apply
        End With
      End With
    End If
    Set objLO = Nothing
  End If
End Sub

Ciao,
Holger

Thanks HaHoBe,

I'm not at home right now, but I'll test your code this evening.

Best regards,

 

[zero269]

Hi zero269,

what about this for a start:

Public Sub MrE_1229014_170230B()
' https://www.mrexcel.com/board/threads/convert-recorded-macro-to-dynamic-values-ranges.1229014/
  Dim objLO As ListObject
  Dim strSort As String
  Dim varRet As Variant
 
  Const cstrSEARCH As String = "Book Status"
 
  On Error Resume Next
  Set objLO = ActiveCell.ListObject
  Err.Clear
  On Error GoTo 0
  If Not objLO Is Nothing Then
    varRet = Application.Match(cstrSEARCH, objLO.HeaderRowRange, 0)
    If Not IsError(varRet) Then
      With objLO
        strSort = .Name & "[[#Headers],[#Data],[Test Date]]"
        .Range.AutoFilter Field:=varRet, Criteria1:=RGB(217, 225, 242), Operator:=xlFilterCellColor
        With .Sort
          With .SortFields
            .Clear
            .Add2 Key:=Range(strSort), _
                  SortOn:=xlSortOnValues, _
                  Order:=xlAscending, _
                  DataOption:=xlSortNormal
          End With
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .SortMethod = xlPinYin
          .Apply
        End With
      End With
    End If
    Set objLO = Nothing
  End If
End Sub

Ciao,
Holger

Hi HaHoBe,

I just tested your code and it works like a charm for filtering the Book Status column by color and then sorting the Test Date column.

I was able to shorten the line for sorting the Test Date:

strSort = .Name & "[[#Headers],[#Data],[Test Date]]"
strSort = .Name & "[Test Date]"

I would like to add another Sort IF criteria, but I'm not sure how recycle these lines to achieve that:

Const cstrSEARCH As String = "Book Status"
varRet = Application.Match(cstrSEARCH, objLO.HeaderRowRange, 0)

I would like to use this code on another Sheet that Sorts a Due Date vs. the Test Date in this case...

Best regards,

 

[HaHoBe]

Hi zero269,

instead of having the terms to search for and sort on hard coded inside the procedure rewrite it to be a Function awaiting those two parameters and returning a Boolean for the success

Private Function fncModifyLO(strSeach As String, _
                              strField As String) As Boolean
' https://www.mrexcel.com/board/threads/convert-recorded-macro-to-dynamic-values-ranges.1229014/
  Dim objLO As ListObject
  Dim strSort As String
  Dim varRet As Variant
  Dim varField As Variant
   
  On Error GoTo err_here
  Set objLO = ActiveCell.ListObject
  If Not objLO Is Nothing Then
    varRet = Application.Match(strSeach, objLO.HeaderRowRange, 0)
    If Not IsError(varRet) Then
      varField = Application.Match(strField, objLO.HeaderRowRange, 0)
      If Not IsError(varField) Then
        With objLO
          strSort = .Name & "[" & strField & "]"
          .Range.AutoFilter Field:=varRet, Criteria1:=RGB(217, 225, 242), Operator:=xlFilterCellColor
          With .Sort
            With .SortFields
              .Clear
              .Add2 Key:=Range(strSort), _
                    SortOn:=xlSortOnValues, _
                    Order:=xlAscending, _
                    DataOption:=xlSortNormal
            End With
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
          End With
        End With
        fncModifyLO = True
      End If
    End If
    Set objLO = Nothing
  End If
  Exit Function
  
err_here:
  fncModifyLO = False
End Function

Calling the function may be done like this (I choose to display a MsgBox in case the function could not get to work):

Public Sub Call_TestDate()

  Const cstrSearch As String = "Book Status"
  Const cstrSortField As String = "Test Date"
  Const cstrMsgTitle As String = "No success on running fncModifyLO"

  If fncModifyLO(cstrSearch, cstrSortField) = False Then
    MsgBox "Problems with " & cstrSearch & " or " & cstrSortField & " or ActiveCell not in a ListObject", vbInformation, cstrMsgTitle
  End If

End Sub

Public Sub Call_DueDate()

  Const cstrSearch As String = "Book Status"
  Const cstrSortField As String = "Due Date"
  Const cstrMsgTitle As String = "No success on running fncModifyLO"

  If fncModifyLO(cstrSearch, cstrSortField) = False Then
    MsgBox "Problems with " & cstrSearch & " or " & cstrSortField & " or ActiveCell not in a ListObject", vbInformation, cstrMsgTitle
  End If

End Sub

Ciao,
Holger

 

[zero269]

Hi zero269,

instead of having the terms to search for and sort on hard coded inside the procedure rewrite it to be a Function awaiting those two parameters and returning a Boolean for the success

Private Function fncModifyLO(strSeach As String, _
                              strField As String) As Boolean
' https://www.mrexcel.com/board/threads/convert-recorded-macro-to-dynamic-values-ranges.1229014/
  Dim objLO As ListObject
  Dim strSort As String
  Dim varRet As Variant
  Dim varField As Variant
  
  On Error GoTo err_here
  Set objLO = ActiveCell.ListObject
  If Not objLO Is Nothing Then
    varRet = Application.Match(strSeach, objLO.HeaderRowRange, 0)
    If Not IsError(varRet) Then
      varField = Application.Match(strField, objLO.HeaderRowRange, 0)
      If Not IsError(varField) Then
        With objLO
          strSort = .Name & "[" & strField & "]"
          .Range.AutoFilter Field:=varRet, Criteria1:=RGB(217, 225, 242), Operator:=xlFilterCellColor
          With .Sort
            With .SortFields
              .Clear
              .Add2 Key:=Range(strSort), _
                    SortOn:=xlSortOnValues, _
                    Order:=xlAscending, _
                    DataOption:=xlSortNormal
            End With
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
          End With
        End With
        fncModifyLO = True
      End If
    End If
    Set objLO = Nothing
  End If
  Exit Function
 
err_here:
  fncModifyLO = False
End Function

Calling the function may be done like this (I choose to display a MsgBox in case the function could not get to work):

Public Sub Call_TestDate()

  Const cstrSearch As String = "Book Status"
  Const cstrSortField As String = "Test Date"
  Const cstrMsgTitle As String = "No success on running fncModifyLO"

  If fncModifyLO(cstrSearch, cstrSortField) = False Then
    MsgBox "Problems with " & cstrSearch & " or " & cstrSortField & " or ActiveCell not in a ListObject", vbInformation, cstrMsgTitle
  End If

End Sub

Public Sub Call_DueDate()

  Const cstrSearch As String = "Book Status"
  Const cstrSortField As String = "Due Date"
  Const cstrMsgTitle As String = "No success on running fncModifyLO"

  If fncModifyLO(cstrSearch, cstrSortField) = False Then
    MsgBox "Problems with " & cstrSearch & " or " & cstrSortField & " or ActiveCell not in a ListObject", vbInformation, cstrMsgTitle
  End If

End Sub

Ciao,
Holger

Hi Holger,

Using a Function definitely does the trick. I like how you're reusing the variable that performs the search for the column headers regardless of values since those are declared in the Sub routine instead.

I'm still in the early stages of learning VBA, however it looks like the power with your searching for the headers are being looped.

    varRet = Application.Match(strSeach, objLO.HeaderRowRange, 0)
    If Not IsError(varRet) Then
      varField = Application.Match([B]strField[/B], objLO.HeaderRowRange, 0)
      If Not IsError(varField) Then
        With objLO
          strSort = .Name & "[" & strField & "]"
          .Range.AutoFilter Field:=varRet, Criteria1:=RGB(217, 225, 242), Operator:=xlFilterCellColor

Const cstrSortField As String = "Test Date"
Const cstrSortField As String = "Due Date"

This works very well for my case. I'll definitively be using this as a learning tool going forward.

Thanks for taking the time to build this for me. It' VERY much appreciated.

Best regards,

ZERO

 

[HaHoBe]

Hi ZERO,

the reason for checking both the search field as well as the sort field is simply to avoid a runtime error which would be raised if the search string is found but due to misspelling or absence of the header the sort field is not found. So only if numbers indicating the column number for both are returned by the variables we can go to work. And I'm sure you noticed that the return value True is passed within the If..End If part of these checks.

Glad we could help on this one, thanks for your feedback, have fun with VBA, and make sure to have more than a short look at Power Query.

Holger