Search columns and paste rows

**DonkeyOte** · 02-26-2009, 08:18 AM

Welcome to the Board.

Something along the lines of the below perhaps ?

Public Sub FilterData()
Dim rngArea As Range
Sheets("sheet2").Columns(1).Clear
Sheets("Sheet1").Select
With Range(Cells(1, Columns.Count), Cells(Rows.Count, "A").End(xlUp).Offset(, Columns.Count - 1))
    .FormulaR1C1 = "=IF(AND(RC2=0,RC3<=0.1,RC4<=0.1),1,""x"")"
    For Each rngArea In .SpecialCells(xlCellTypeFormulas, xlNumbers).Areas
        Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(rngArea.Rows.Count).Value = rngArea.Offset(, 1 - Columns.Count).Value
    Next rngArea
    .Clear
End With
End Sub

**chambone** · 02-26-2009, 11:55 AM

Thank you very much for your help DonkeyOte, worked perfectly.

I now have a different but similar problem.

I need to search Column B for the number 4 and then copy the values in Columns G,H,I and J into sheet 2.

The attached file is just an extract of all the data. As you can see the columns increse from I to J in row 24. In the actual file this occurs in row 326198.

I dont know if it makes a difference but in the actual data the number of columns occupied by values decreses

**DonkeyOte** · 02-26-2009, 12:09 PM

Public Sub FilterData()
Dim rngArea As Range, xlCalc As XlCalculation
On Error GoTo Handler
With Application
    xlCalc = Application.Calculation
    .Calculation = xlCalculationManual
    .Application.ScreenUpdating = False
    .EnableEvents = False
End With
Sheets("sheet2").Columns(1).Clear
Sheets("Sheet1").Select
With Range(Cells(1, Columns.Count), Cells(Rows.Count, "A").End(xlUp).Offset(, Columns.Count - 1))
    .FormulaR1C1 = "=IF(RC2=4,1,""x"")"
    For Each rngArea In .SpecialCells(xlCellTypeFormulas, xlNumbers).Areas
        Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(rngArea.Rows.Count, 4).Value = rngArea.Offset(, 7 - Columns.Count).Resize(, 4).Value
    Next rngArea
    .Clear
End With
ExitPoint:
With Application
    .Calculation = xlCalc
    .Application.ScreenUpdating = True
    .EnableEvents = True
End With
Exit Sub

Handler:
MsgBox "Error etc...", vbCritical, "Error"
Resume ExitPoint

End Sub

Others may suggest Auto Filter... given the volume of data I don't know how feasible that is... I added in some Application events given that fact (re: calculation, screenupdating and events)