Excel - Export cells identified by countif to new file

Question

I'm trying to export cells identified by countif to a new file.

For example, given:

Red      dog
Blue     cat
Red      horse
Purple   bird
Red      mouse

I can get countif to count the number of times Red occurs in column A. But how can I have excel write the contents of Column A and B to a new file (csv?) only if Column A is Red?

So the output would be

Red    dog
Red    horse
Red    mouse

In this example, I could manually sort this list and copy it, but my actual conutif statement (technically countifs) has 4 or 5 variables.

Thanks, Avram

Answer 1

Probably a more elegant solution, but this will work. Add a helper column that will be true or false depending if the row meets all of your criteria. This will generate a table similar to following

Red     Dog     TRUE
Blue    Cat     FALSE
Red     Horse   TRUE
Purple  Bird    FALSE
Red     Mouse   TRUE

Then, a simple macro will copy and rows with true to a new sheet. Edit as needed (not necessarily the most elegant, but gets the job done)

Sub copyCriteriaRange()
Dim rcounter As Integer, outputRow As Integer, dataVariant As Variant

outputRow = 1
'loop through all rows

For rcounter = 1 To 5
  'if column 3 is true, copy to a new sheet
  If Sheets("Sheet1").Cells(rcounter, 3) = True Then
     dataVariant = Sheets("Sheet1").Range("A" & rcounter & ":C" & rcounter)
     Sheets("Sheet2").Range("A" & outputRow & ":C" & outputRow) = dataVariant
     outputRow = outputRow + 1
  End If
Next

'now get rid of helper column
Sheets("Sheet2").Range("C:C").ClearContents
MsgBox "Done copying"
End Sub

Then can use another macro to export to csv. Should be easy enough to find one through Google. Enjoy!

Answer 2

For formulas:

In another sheet in A1 put the desired test, in this case "Red". In A2 put this formula:

=IF(ROW()<=COUNTIF(Sheet8!$A$1:$A$5,$A$1),$A$1,"")

And copy down as many rows as desired.

In B1 put this array formula:

=IF(A1<>"",INDEX(Sheet8!$B$1:$B$5,LARGE(ROW($1:$5)*ISNUMBER(FIND(A1,Sheet8!$A$1:$A$5)),COUNTA($A$1:$A1))),"")

Change all Sheet8 references to the name of the sheet that holds the data. To enlarge the data being searched fix the ranges Sheet8!$B$1:$B$5 and Sheet8!$A$1:$A$5 to match the size. As well as the ROW($1:$5) needs to include the same number of rows of data.

Confirm with Ctrl-Shift-Enter and copy down.

---

For a UDF that you can use as a function:

Function Avram(val As String, IRng As Range, k As Long)
Dim rng
Dim j As Long
Dim i As Long

rng = IRng.Value
j = 1
For i = LBound(rng, 1) To UBound(rng, 1)
    If rng(i, 1) = val Then
        If j = k Then
            Avram = rng(i, 2)
            Exit Function
        Else
            j = j + 1
        End If
    End If
Next i

Avram = CVErr(xlErrNA)


End Function

This wold go in a module attached to the workbook (Not the workbook or worksheet code)

You would enter Column A on the sheet as stated in the formula part above. Then in B1 you would enter:

=IFERROR(Avram(A1,Sheet8!$A$1:$B$5,COUNTA($A$1:$A1)),"")

This time the only thing needing change is the Sheet8!$A$1:$B$5 to include your range of data. This is less finicky than the array formula and faster.

---

As for a Sub to do it all then:

Sub avram2()

Dim ows As Worksheet
Dim tws As Worksheet
Dim rng
Dim Orng
Dim i As Long
Dim FndString As String

FndString = "Red" 'Change to what you want

Set ows = Sheets("Sheet8") 'Change to your sheet name with the data.
Set tws = Sheets("Sheet9") 'Change to the output sheet name

With ows
    rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp)).Value
End With
For i = LBound(rng, 1) To UBound(rng, 1)
    If rng(i, 1) = FndString Then
        tws.Cells(tws.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2).Value = Array(rng(i, 1), rng(i, 2))
    End If
Next i

End Sub