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

A

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

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
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
Fluff said:
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
Click to expand...
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
Fluff said:
Just change the value that you are filtering on.
Click to expand...
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
Fluff said:
Can you post the code that you are using.
Click to expand...

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
Fluff said:
What is the point of asking for help & then basically ignoring what has been suggested?
Click to expand...

Fluff said:
What is the point of asking for help & then basically ignoring what has been suggested?
Click to expand...
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
You must log in or register to reply here.

Similar threads

S
  • Solved
Return error if "Filter" doesn't return the required entry
Replies
2
Views
118
skittlz
S
D
  • Solved
VBA If statement to continue
2
Replies
17
Views
559
dinunan
D
I
  • Question Question
Filter column on text value if that value exists using VBA
Replies
7
Views
102
Peter_SSs
Peter_SSs
C
  • Question Question
Tab Selection from Userform based on Date range
Replies
5
Views
111
campbell1093
C
N
  • Question Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
453
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,236
Messages
6,170,906
Members
452,366
Latest member
TePunaBloke

Share this page

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