Copy all columns where criteria is met to different sheet

[JasonPrice]

I have a spread sheet that gets populated with data from a number of source text files. That text is then stripped down to the relevant data and collated into columns on another sheet (sheet 2).


I now need to copy all columns that meet a certain criteria to a third sheet.


For example, if cell A1 in sheet 2 <> "", then copy A2:A40 in sheet 2 to the next available column in sheet 3.


With a sample set of data I have 10 columns of data in sheet 2, but only 8 of them meet the criteria. I want those 8 columns copied across to sheet 3 all next to each other (no empty columns).


I've searched through various forums but I can't work out what the macro should be to make it work.


Any suggestions?

 

[gallen]

Re: Excel - Copy all columns where criteria is met to different sheet

Hello and welcome

This code should work based on your example. Untested. Please test on copy of your work. Place this in to a module. If you are unsure how to do that let me know.

Thanks

Sub CopyData()
    Dim wsCopy As Worksheet, wsPaste As Worksheet
    Dim nc As Long 'next column to paste to
    
    Set wsCopy = Worksheets("Sheet2")
    Set wsPaste = Sheets("Sheet3")
    
    If wsCopy.Range("A2") <> "" Then
        nc = wsPaste.Cells(1, Columns.Count).End(xlToLeft).Column + 1
        wsCopy.Range("A2:A40").Copy
        wsPaste.Cells(1, nc).PasteSpecial xlPasteValues
    End If
    
End Sub

 

[JasonPrice]

Re: Excel - Copy all columns where criteria is met to different sheet

Thank you. That works quite well for column A.

How do I get it to check, and then copy from, multiple columns though?

I have 10 columns in my sample data (A through J) of which 8 columns meet the criteria.

The cell for the criteria is cell 1 in each column, and the data is in 2 through 40 in each. So it needs to check A1, and copy A2:A4, then check B2 and copy B2:B40, etc.

Hello and welcome

This code should work based on your example. Untested. Please test on copy of your work. Place this in to a module. If you are unsure how to do that let me know.

Thanks

Sub CopyData()
    Dim wsCopy As Worksheet, wsPaste As Worksheet
    Dim nc As Long 'next column to paste to
    
    Set wsCopy = Worksheets("Sheet2")
    Set wsPaste = Sheets("Sheet3")
    
    If wsCopy.Range("A2") <> "" Then
        nc = wsPaste.Cells(1, Columns.Count).End(xlToLeft).Column + 1
        wsCopy.Range("A2:A40").Copy
        wsPaste.Cells(1, nc).PasteSpecial xlPasteValues
    End If
    
End Sub

 

[JasonPrice]

Re: Excel - Copy all columns where criteria is met to different sheet

Should say "So it needs to check A1, and copy A2:A40, then check B2 and copy B2:B40, etc."

 

[gallen]

Re: Excel - Copy all columns where criteria is met to different sheet

Hello,

A little modification:

Sub CopyData()
    Dim wsCopy As Worksheet, wsPaste As Worksheet
    Dim nc As Long 'next column to paste to
    
    Set wsCopy = Worksheets("Sheet2")
    Set wsPaste = Sheets("Sheet3")
    
    For i = 1 To 10
        'Check First cell of the column - criteria - isn't empty
        If wsCopy.Cells(1, i) <> "" Then
            'get next column to paste to
            nc = wsPaste.Cells(1, Columns.Count).End(xlToLeft).Column + 1
            'Copy rows 2 to 40
            wsCopy.Range(wsCopy.Cells(2, i), wsCopy.Cells(40, i)).Copy
            'Paste to next column
            wsPaste.Cells(1, nc).PasteSpecial xlPasteValues
        End If
    Next i
End Sub

A friendly hint : Just post your exact requirements in your first post when asking for help rather than 'building' towards your solution. It prevents those helping from having to write several solutions to what is ultimately a single issue.

Again this code is untested (except testing it in my head!) so please run on a copy of your data.

If you have other macro code in your workbook you may want to prevent events from triggering too.

 

[gallen]

Re: Excel - Copy all columns where criteria is met to different sheet

Apologies, I was lazy. The code, including error handling and performance optimising is this:

Sub CopyData()
    Dim wsCopy As Worksheet, wsPaste As Worksheet
    Dim nc As Long 'next column to paste to
    
    Set wsCopy = Worksheets("Sheet2")
    Set wsPaste = Sheets("Sheet3")
    
    'if an error occurs jump to error handling section
    On Error GoTo errHandle
    
    'Stop events and screen updating. Will help performance.
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For i = 1 To 10
        'Check First cell of the column - criteria - isn't empty
        If wsCopy.Cells(1, i) <> "" Then
            'get next column to paste to
            nc = wsPaste.Cells(1, Columns.Count).End(xlToLeft).Column + 1
            'Copy rows 2 to 40
            wsCopy.Range(wsCopy.Cells(2, i), wsCopy.Cells(40, i)).Copy
            'Paste to next column
            wsPaste.Cells(1, nc).PasteSpecial xlPasteValues
        End If
    Next i
    
'handle any errors
errHandle:


    'make sure to reenable any disabled items even if there is an error
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    'if there is an error, display the info
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbCritical, "Error number " & Err.Number & " Generated."
    End If
    
End Sub

 

[JasonPrice]

Re: Excel - Copy all columns where criteria is met to different sheet

Thank again.

Sorry about the question. I thought I did ask for the multiple columns bit, but re-reading my OP I can see I didn't really state that properly.

Apologies, I was lazy. The code, including error handling and performance optimising is this:

Sub CopyData()
    Dim wsCopy As Worksheet, wsPaste As Worksheet
    Dim nc As Long 'next column to paste to
    
    Set wsCopy = Worksheets("Sheet2")
    Set wsPaste = Sheets("Sheet3")
    
    'if an error occurs jump to error handling section
    On Error GoTo errHandle
    
    'Stop events and screen updating. Will help performance.
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For i = 1 To 10
        'Check First cell of the column - criteria - isn't empty
        If wsCopy.Cells(1, i) <> "" Then
            'get next column to paste to
            nc = wsPaste.Cells(1, Columns.Count).End(xlToLeft).Column + 1
            'Copy rows 2 to 40
            wsCopy.Range(wsCopy.Cells(2, i), wsCopy.Cells(40, i)).Copy
            'Paste to next column
            wsPaste.Cells(1, nc).PasteSpecial xlPasteValues
        End If
    Next i
    
'handle any errors
errHandle:


    'make sure to reenable any disabled items even if there is an error
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    'if there is an error, display the info
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbCritical, "Error number " & Err.Number & " Generated."
    End If
    
End Sub

 

[gallen]

Re: Excel - Copy all columns where criteria is met to different sheet

No problem at all.

Having re-read your OP i see I should have asked more questions.

Let me know if the code has any issues.