Update Cell Value in Filtered Sheet Via VBA

Question

I am trying to update column value of filtered data in excel via VBA

I wrote a small macro, which do filter on below table.

After running macro to filter the sheet, I see below

Now what I want to do is, I want to update Location value of filtered data. I am trying by using below:

Range("E100000").SpecialCells(xlCellTypeVisible).Offset(1,0).value ="Abc"

this set value always at A2 cell which is not part of filtered data. Need help on how to set /update value one by one in column E for filtered data.

Thanks in Advance! Vikas

here is my code:


Sub Macro3()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("TempSheet")
weeklyCommCount = InputBox"Enter Weekly
Communication Count (in number)")
repeateDate = CDate(InputBox"Enter Planning Start
Date ('DD-MMM-YY')", "CHR Planning", "01-Apr-24"))
For i = 1 To 40
For j = 1 To weeklyCommCount
'this is working when sheet is not filtered
Range("E100000").End(xUp). Offset(1, 0). Value = repeate Date
"not working setting alads a Ariying below whic is
Range("E100000").SpecialCells(x|Cel|TypeVisible). Offs
et(1, 0). Value = repeateDate
Next
repeateDate = repeateDate + 7
Next
End Sub

Answer 1

Filter/Replace Data

The Calling Procedure

Sub FilterReplaceData()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
    
    FilterListSingleCriteria ws, "A4", 4, "M"
    
    ReplaceFilteredColumnValues ws, 5, ws.Range("A2").Value
    
End Sub

The Called (Helper) Procedures

Sub FilterListSingleCriteria( _
        ws As Worksheet, _
        FirstListCellAddress As String, _
        FilterColumnIndex As Long, _
        FilterCriteriaString As String)
    ws.AutoFilterMode = False
    RefCurrentRegion(ws.Range(FirstListCellAddress)) _
        .AutoFilter FilterColumnIndex, FilterCriteriaString
End Sub

Sub ReplaceFilteredColumnValues( _
        ws As Worksheet, _
        ColumnIndex As Long, _
        Replacement As Variant)
    
    If Not ws.FilterMode Then
        MsgBox "No filtered data found!", vbExclamation
        Exit Sub
    End If
    
    If Not ws.AutoFilterMode Then
        MsgBox "No autofiltered data found!", vbExclamation
        Exit Sub
    End If
    
    Dim rg As Range
    
    With ws.AutoFilter.Range
        With .Resize(.Rows.Count - 1).Offset(1)
            On Error Resume Next
                Set rg = Intersect(.Cells, .Columns(ColumnIndex)) _
                    .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
    End With
    
    If rg Is Nothing Then
        MsgBox "No filtered rows found.", vbExclamation
        Exit Sub
    End If
    
    ' The same value in all filtered cells.
    rg.Value = Replacement
        
    ' Use something like the following with your new 'Date' requirement 
    ' instead of the previous line.
        
'    If Not IsDate(Replacement) Then
'        MsgBox "The replacement is not a date!", vbExclamation
'        Exit Sub
'    End If
'
'    Dim cell As Range
'
'    For Each cell In rg.Cells
'        cell.Value = Replacement
'        Replacement = Replacement + 7
'    Next cell
        
End Sub

Function RefCurrentRegion( _
    ByVal FirstCell As Range) _
As Range
    With FirstCell.Cells(1).CurrentRegion
        Set RefCurrentRegion = FirstCell.Resize(.Row + .Rows.Count _
            - FirstCell.Row, .Column + .Columns.Count - FirstCell.Column)
    End With
End Function

Answer 2

You can try this:

The input box will preserve the text for the next input.

Sub ins_rows()

defaultx = "Type in text"
For i = 2 To UsedRange.Rows.Count
  If Rows(i).Hidden = False Then
     Cells(i, 5) = InputBox("Text to insert:", , defaultx)
     defaultx = Cells(i, 5)
  End If
  

Next i

End Sub