decadence
Well-known Member
- Joined
- Oct 9, 2015
- Messages
- 525
- Office Version
- 365
- 2016
- 2013
- 2010
- 2007
- Platform
- Windows
Hi, I am having a problem where I am trying to add specific text to a filtered column in the visible cells only but the code below adds the text below the used range. I would like to only add the text to the filtered visible cells not including the header, can some one help with this please
Code:
Sub AddText()
Dim xTitleId As Variant, Rng As range, Rng2 As range, x As range, i As range, c As range, addStr As String
Application.ScreenUpdating = False
For Each i In range("A1:Z2")
Select Case i.value2
Case "IPN", "Part", "Part Number"
If Not Rng Is Nothing Then
Set Rng = Union(Rng, i)
Else
Set Rng = i
End If
End Select
Next
If Rng Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Not Rng Is Nothing Then
Set Rng = Rng.Resize(Cells(Rows.Count, Rng.Column).End(xlUp).row).Offset(1)
Rng.AutoFilter Field:=1, Criteria1:="<>*DNF_*", Operator:=xlAnd, Criteria2:="<>*FID_*"
For Each i In range("A1:Z2")
Select Case i.value2
Case "IPN", "Part", "Part Number"
If Not Rng2 Is Nothing Then
Set Rng2 = Union(Rng, i)
Else
Set Rng2 = i
End If
End Select
Next
If Rng2 Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Not Rng2 Is Nothing Then
Set Rng2 = Rng2.Resize(Cells(Rows.Count, Rng.Column).End(xlUp).row).Offset(1)
On Error Resume Next
addStr = Application.InputBox("Add Prefix", xTitleId, "", Type:=2)
If addStr = "False" Then
ActiveSheet.AutoFilterMode = False
MsgBox "No Prefixes Added!"
Exit Sub
Else
Application.ScreenUpdating = False
For Each x In Rng2.SpecialCells (xlCellTypeVisible)
x.Value = addStr & x.Value
Next x
End If
End If
End If
ActiveSheet.AutoFilterMode = False
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Last edited: