Convert Recorded Macro to Dynamic Values/Ranges

Z

zero269

Board Regular
Joined
Jan 16, 2023
Messages
219
Office Version
  1. 365
Platform
  1. Windows
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:

VBA Code: 
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
AB
1Test DateBook Status
210-FebActive
310-FebHeld
410-FebIn Transit
509-FebActive
609-FebHeld
709-FebIn Transit
808-FebIn Transit
907-FebActive
1007-FebHeld
1107-FebIn Transit
1206-FebActive
1306-FebHeld
1403-FebActive
1503-FebIn Transit
Books
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B2:B15Expression=SUM(COUNTIF($B2,cfBookStatus))textNO
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
Hi zero269,

what about this for a start:

VBA Code: 
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
 
Upvote 0
HaHoBe said:
Hi zero269,

what about this for a start:

VBA Code: 
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
Click to expand...
Thanks HaHoBe,

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

Best regards,
 
Upvote 0
HaHoBe said:
Hi zero269,

what about this for a start:

VBA Code: 
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
Click to expand...
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:
VBA Code: 
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:
VBA Code: 
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,
 
Upvote 0
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

VBA Code: 
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):

VBA Code: 
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

VBA Code: 
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
 
Upvote 1
Solution
HaHoBe said:
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

VBA Code: 
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):

VBA Code: 
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

VBA Code: 
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
Click to expand...
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.

VBA Code: 
    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

VBA Code: 
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
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Solved
VBA: Use Variable with Sort Range
Replies
5
Views
1K
zero269
Z
D
  • Question
VBA code works when called directly, but not from another routhine
Replies
7
Views
708
davidepstein22
D
ajjava
  • Question
Procedure to find MAX VALUE in a SPECIFIC pivot table value field, in the case of MULTIPLE pivot table value fields
Replies
0
Views
833
ajjava
ajjava
S
  • Solved
Sorting macro
2
Replies
13
Views
713
sspatriots
S
B
  • Question
VBA/Macro (dynamic ranges) IF And Statement that uses interior color in column A and blank in column F
Replies
0
Views
469
blooeyez
B

Forum statistics

Threads
1,215,006
Messages
6,122,666
Members
449,091
Latest member
peppernaut

Share this page

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