You are here:

Excel/Problems pasting into filtered range (VBA)

Advertisement


Question
QUESTION: I'm trying to figure out how to do something in VBA that's very simple manually, but it needs to be part of a macro I've got.

I need to filter column N by a set of criteria and the select the first visible field to insert a formula into. I have this working so far:

(Selecting the first match in column N from the filtered range) ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 14).Select

ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[1],"")"")"

I need to paste this over all the subsequent rows that are visible as well, which works with this:

Range(Selection, Selection.End(xlDown)).Select

This is fine, but only if I have more than one row visible. Problem is, when I only have that one row visible it pastes it all the way down to Excel's row limit. And if my filtered range excludes everything (nothing matches the filter), then it puts the formula on the first blank row at the bottom and pastes all the way down.

I imagine I need some conditionals, but I'm stumped as to what they need to be. Please point me in the right direction.

Thanks!

ANSWER: Steve

I like to use range references to decrease the amount of code.  I will show you how to determine the number of visible rows (filter result)

Since I limit my range reference to a single column, then I can just use count rather than rows.count to determine the number of visible rows in the filter.  I have to use error trapping because if I do specialcells(xlvisible) on a range that has no visible cells then it raises an error.


Dim r as Range
Dim r1 as Range
set r1 = nothing
set r = nothing
set r = ActiveSheet.AutoFilter.Range.Resize(,1)  ' single column
set r = r.offset(1,0).Resize(r.rows.count)
on error resume next
 set r1 = r.specialcells(xlvisible)
on error goto 0

if r1 is nothing then
 ' no visible rows
elseif r1.count = 1 then
 ' one visible row
elseif r1.count > 1 then
 ' multiple visible rows
end if

So you should be able to put in the code you want to execute for each condition.

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: Thanks for the quick response! I think I understood how that works. Here's what I put in:

Dim r As Range
Dim r1 As Range
Set r1 = Nothing
Set r = Nothing
Set r = ActiveSheet.AutoFilter.Range.Resize(, 1) ' single column
Set r = r.Offset(1, 0).Resize(r.Rows.Count)

On Error Resume Next
Set r1 = r.SpecialCells(xlVisible)

On Error GoTo 0

If r1.Count = 1 Then
   ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 14).Select
   ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[1],"")"")"
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False

ElseIf r1.Count > 1 Then
   ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 14).Select
   ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[1],"")"")"
   Selection.Copy
   Range(Selection, Selection.End(xlDown)).Select
   ActiveSheet.Paste
   ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 14).Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False

ElseIf r1 Is Nothing Then
End If
--------------------------------

Although my filter is returning only 1 row, it's still executing the code under the r1.Count > 1 condition. Am I misapplying something?

ANSWER: Steve,

I approached this slightly differently.  This worked for me.   Also I added a "-1" to the 6th line of code since I forgot to do that in my original answer.  

Tested and worked for me. In my tests, it executed different code (correct code) for one visible row and multiple visible rows.  

Sub abc()
Dim r As Range
Dim r1 As Range, r2 As Range
Set r1 = Nothing
Set r = Nothing
Set r = ActiveSheet.AutoFilter.Range.Resize(, 1) ' single column
Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1)  ' < = Added "- 1" to this code

On Error Resume Next
Set r1 = r.SpecialCells(xlVisible)

On Error GoTo 0

If r1.Count = 1 Then
   Set r2 = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 14)
   With r2
      .FormulaR1C1 = "=CONCATENATE(RC[1],"")"")"
      .Formula = .Value
   End With
    
ElseIf r1.Count > 1 Then
   Set r2 = Intersect(r1.EntireRow, r1(1).Offset(0, 13).EntireColumn)
   With r2
    .FormulaR1C1 = "=CONCATENATE(RC[1],"")"")"
    .Formula = .Value
   End With

ElseIf r1 Is Nothing Then
End If
End Sub

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: Much tidier code! I'm getting a Run-time error '91' "Object variable or With block variable not set" error on this line:

Set r = ActiveSheet.AutoFilter.Range.Resize(, 1) ' single column

Any ideas?

Answer
Steve,

My guess is that the activesheet does not have an autofilter.  If you are using Tables instead of a stand alone autofilter, then the active cell must be in the table when you use that line of code.  If it is a standalone autofilter, then I would suspect the autofilter is not in effect when you get the error (should be no dropdown arrows at the top of the filter meaning the filter does not exist).

As I said, the code was tested in Excel 2007 and worked for me.  (I did have an active stand alone autofilter on the activesheet.

--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.