How to swap two cell ranges after applying filter VBA?

user_15765575 0
Viewed 147

[![Rows to swap][1]][1]I am working on a code that applies a filter (criteria is taken from another file, and that works fine), and then it has to swap the data of the two filtered rows. However, I am facing error as it selects the unfiltered data range in third row even though I apply the Visible cell type function.

So basically after the filter is applied, I want to swap the data between B76 and B82 and G76:AP76 and G82:AP82 `

Windows("complete Availability 22-3-2021").Activate
ActiveSheet.Range("$A$2:$EL$1561").AutoFilter Field:=1, Criteria1:= _
        po1, Operator:=xlOr, Criteria2:=pi1
Dim r1 As Range
Dim r2 As Range
Set r1 = Range("B2,G2:AP2").Offset(Rowoffset:=1, Columnoffset:=0).SpecialCells(xlCellTypeVisible)
tmp1 = r1
Set r2 = Range("B2,G2:AP2").Offset(Rowoffset:=2, Columnoffset:=0).SpecialCells(xlCellTypeVisible)

tmp2 = r2
r1 = tmp2
r2 = tmp1

End Sub
autofilter vba excel
1 Answers

You did not answer my clarification questions, but I cannot stop myself thinking that you need swapping the mentioned ranges in the filtered range. If so, please try the next code:

Sub testSwapColumnsVC()
 Dim rngF As Range, po1 As String, pi1 As String, r1 As Range, r2 As Range
 Dim arrtemp, firstC As String, lastC As String, cel As Range
 Dim arrHidCol, colN As Long, i As Long, k As Long, sh As Worksheet, boolOptimized As Boolean
 
   boolOptimized = True 'change it in False when debugging!
   
   If boolOptimized Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        Application.EnableEvents = False
   End If
 
  Set sh = ActiveSheet     'use here your sheet by its name
  
  po1 = "AA": pi1 = "BB" 'use here your criteria (I used these only for testing reason)
  
    sh.AutoFilterMode = False 'no need to manually eliminate the filter

    sh.Range("$A$2:$EL$1561").AutoFilter field:=1, Criteria1:= _
                                    po1, Operator:=xlOr, Criteria2:=pi1
                                         
    'Unhide the hidden columns, and memorize them in an array:__
    colN = sh.UsedRange.Columns.count
    ReDim arrHidCol(colN)
    For i = 1 To colN
        If sh.cells(1, i).EntireColumn.Hidden Then
            sh.cells(1, i).EntireColumn.Hidden = False
            arrHidCol(k) = i: k = k + 1
        End If
    Next
    ReDim Preserve arrHidCol(k - 1) 'keep only the array elements having values
    '__________________________________________________
    
    Set rngF = ActiveSheet.Range("$A$2:$EL$1561").SpecialCells(xlCellTypeVisible) 'the filtered Total range
    
    Set r1 = setRangeByRow(rngF, 2)  'create the range of the second filtered/visible cells row
    Set r2 = setRangeByRow(rngF, 3)  'create the range of the third filtered/visible cells row
    
    firstC = r1.cells(1).Address(0, 0)        'r1 Range first cell address
    lastC = Split(r1.Address(0, 0), ":")(1) 'r1 Range last cell address

  arrtemp = Range(firstC & ":" & lastC).value 'keep an unchanged reference of r1 (but continuous range!)
  For Each cel In r1.cells                             'use the r1  cells as column reference!
      cel.value = r2.cells(1, cel.Column - (r1.Column - 1)).value 'swap the cells value placing r2 ones in r1
      'use the temp array to swap in r2 cells:
      r2.cells(1, cel.Column - (r1.Column - 1)).value = arrtemp(1, cel.Column - (r1.Column - 1))
 Next cel
 
 'Hide the previous hidden columns_______
 For i = 0 To UBound(arrHidCol)
    sh.Columns(arrHidCol(i)).Hidden = True
 Next
 '__________________________________
 
 'Remove optimization:
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = True
End Sub

Function setRangeByRow(rng As Range, iRow As Long) As Range 'create the range for a specific filtered area row
    Dim i As Long, j As Long, A As Range
    For Each A In rng.Areas
        For j = 1 To A.rows.count
            i = i + 1
            If i = iRow Then
                Set setRangeByRow = Intersect(A.rows(j), rng.Parent.Range("B:B,G:AP"))
                Exit Function
            End If
        Next j
    Next
End Function

Edited:

I adapted the code to work in case of hidden columns, too. Excel is not able to create an acurate intersection between discontinuous ranges...

Now, i firstly unhide the hidden columns, memorize them in an array and re hide them at the end.

Besides that, it has some optimization setting, in order to make the code faster.

Please, send some feedback after testing it...

user_22333080
Related