I have been using this below function from couple of weeks and i did not realized that when this function is run on the filtered cells.

It copy and paste the irrelevant data on the range where function has ran. I hope someone can help on the issue. I would appreciate the help.

`Sub makeUpper(rng As Range)
    Dim v As Long, w As Long, vUPRs As Variant

    With rng
        If .CountLarge = 1 Then
            ' create array if rng is a single-cell
            ReDim vUPRs(1 To 1, 1 To 1)
            vUPRs(1, 1) = .Value2
        Else
            vUPRs = .Value2
        End If

        For v = LBound(vUPRs, 1) To UBound(vUPRs, 1)
            For w = LBound(vUPRs, 2) To UBound(vUPRs, 2)
                vUPRs(v, w) = UCase(vUPRs(v, w))
            Next
        Next

        .Value2 = vUPRs
    End With
End Sub`

This function should be run on the file. I have tried to add this line but it does not work `

Selection.SpecialCells(xlCellTypeVisible).Areas

`

Before Applying the code:

After Applying the code:

CodePudding user response：

Upper-Case a Discontinuous Range

Sub MakeUpper(ByVal rng As Range)
    Dim ws As Worksheet: Set ws = rng.Worksheet
    Dim arg As Range
    For Each arg In rng.Areas
        arg.Value = ws.Evaluate("=UPPER(" & arg.Address & ")")
    Next arg
End Sub

• If you want to stick with the array solution, you could use the following.

Sub MakeUpperArray(ByVal rng As Range)
    
    Dim arg As Range, vUPRs, vUPR, v As Long, w As Long
    
    For Each arg In rng.Areas
        With arg
            If .CountLarge = 1 Then
                ' create array if rng is a single-cell
                ReDim vUPRs(1 To 1, 1 To 1)
                vUPRs(1, 1) = .Value2
            Else
                vUPRs = .Value2
            End If
    
            For v = 1 To UBound(vUPRs, 1)
                For w = 1 To UBound(vUPRs, 2)
                    vUPR = vUPRs(v, w)
                    If VarType(vUPR) = vbString Then
                        vUPRs(v, w) = UCase(vUPR)
                    End If
                Next w
            Next v
    
            .Value2 = vUPRs
        End With
    Next arg

End Sub