VBA Code : Based on filter selected need to make changes in column

avicric

Board Regular
Joined
Apr 24, 2017
Messages
59
Office Version
  1. 2019
Platform
  1. Windows
Hi All,

Need your help with VBA code, I have to make changes to a column based on the filter selected in another column.

So I have to put/select filter in "column E" based on the filtered item need to rename all items in "column S"...

I have managed the below code but if 1 of the item is missing from the filter in "column E" the VBA just hangs....

Selection.AutoFilter
ActiveSheet.Range("$A:$V").AutoFilter field:=5, Criteria1:= _
"Assigned to Finance"
Range("S1").Select
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
Range("S1").Select
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
Range(Selection, Selection.End(xlDown)).Select
Selection.FormulaR1C1 = "Finance"

Thanks for your help in advance.
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
How about
VBA Code:
Sub avicric()
   Dim UsdRws As Long
   
   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Assigned to Finance"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
         .AutoFilter.Range.Offset(1).Resize(UsdRws - 1).Columns(19).Value = "Finance"
      End If
   End With
End Sub
 
Upvote 0
How about
VBA Code:
Sub avicric()
   Dim UsdRws As Long
  
   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Assigned to Finance"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
         .AutoFilter.Range.Offset(1).Resize(UsdRws - 1).Columns(19).Value = "Finance"
      End If
   End With
End Sub
Hi Fluff,
It works, but I have to select other options in the column E and make changes according to the selected filter in column S....
How do I do that....
I am not a expert at all and only know to record a macro use it.....
I did the same for this it worked fine as long as all the filter options were present....it hanged on me when one of the filter option was missing....
Thank you again.....
 
Upvote 0
Just change the value that you are filtering on.
 
Upvote 0
Just change the value that you are filtering on.
Hi Fluff,
I did that and the code works for the first few filters selected and then throws a Run time error '6' overflow....
I checked on this forum and the solution that has worked for this is by using "Dim UsdRws As Long"
So now I am stuck....
 
Upvote 0
Can you post the code that you are using.
 
Upvote 0
Can you post the code that you are using.

Hi Fluff,

please find below the code I am using....

VBA Code:
Sub Latest_Comments()

   Dim UsdRws As Long

    Application.ScreenUpdating = False
    
   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Assigned to Finance"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
    Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "Finance"
   End If
  End With
   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Bank details required"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
      Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "CC Team"
   End If
  End With
   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Awaiting documents/payment from customer"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
       Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "CC Team"
   End If
  End With
       With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Visit not Confirmed - Customer Delay"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
       Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "CC Team"
   End If
  End With

   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Visit failed - Customer unavailable"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
       Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "CC Team"
   End If
  End With

   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Assigned to Replacement"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
       Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "Replacement"
   End If
  End With

   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Same/Equi Device Booking Initiated"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
       Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "Replacement"
   End If
  End With

   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Replacement - Customer Approval Pending"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
       Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "Replacement"
   End If
  End With

   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Advance Payment Before Repair"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
       Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "Replacement"
   End If
  End With

   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Reestimate - Pending Approval"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
       Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "Replacement"
   End If
  End With

   With ActiveSheet
      UsdRws = .Range("E" & Rows.Count).End(xlUp).Row
      .Range("A1:V" & UsdRws).AutoFilter 5, "Pending Approval - Estimate received"
      If .Range("A1:A" & UsdRws).SpecialCells(xlVisible).Count > 1 Then
       Range("S1").Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "Replacement"
   End If
  End With

    Selection.AutoFilter
    Application.ScreenUpdating = True
   
    Range("A1").Select

End Sub
 
Last edited by a moderator:
Upvote 0
What is the point of asking for help & then basically ignoring what has been suggested?
 
Upvote 0
What is the point of asking for help & then basically ignoring what has been suggested?

What is the point of asking for help & then basically ignoring what has been suggested?
Hi Fluff,
With what you had suggested the code dint to anything....hence I had to tweak it with my basic knowledge to get it working...and honestly after the tweak it did work....I get the runtime error at the second last change....not right at the beginning....
And just to let you know i am way below novice when it comes to VBA....so I use what others have posted and modify it to get it working....
I didn't mean to any harm....
So sorry if this has offended you in any way...
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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