Vba solution for copying columns to another sheet based on condition

Last Edited By Krjb Donovan
Last Updated: Mar 05, 2014 10:02 PM GMT


I have a worksheet ("Master") with a potentially infinite number of columns. Each column represents an individual job, and row 7 names the client for which each job was carried out. New columns are added each time a new job is booked.

I have a second sheet ("Client 1"), into which I wish to copy all job columns from "Master" which were done for the client named "Client 1". In other words, I want a script which looks along row 7, sees an entry for "Client 1" and copies that whole column into the "Client 1" sheet, then moves on to look for the next instance of "Client 1" in row 7.

Also, I have another row to show whether the job is pending or completed, and would like any completed job columns to be ignored if at all possible.

Thank-you in advance for any help you can offer!



test this code on a copy of your workbook until you are satisfied it does what you want.

You didn't specify where to look for thecompleted. In the code, I chose row 9. You can change it to the correct row by changing this line of code:

    If InStr(1, r.Parent.Cells(9, cell.Column).Value, "completed", vbTextCompare) = 0 Then

Change the "9" to whatever row will contain the"completed"

Sub copycolumns() Dim r As Range, r1 As Range, cell As Range With Worksheets("Master")

 Set r = .Range("A7", .Cells(7, .Columns.Count).End(xlToLeft))

End With For Each cell In r

 If InStr(1, cell, "client 1", vbTextCompare) Then
    If InStr(1, r.Parent.Cells(9, cell.Column).Value, "completed", vbTextCompare) = 0 Then
       If r1 Is Nothing Then
         Set r1 = cell
         Set r1 = Union(r1, cell)
       End If
    End If
 End If

Next If Not r1 Is Nothing Then

 r1.EntireColumn.Copy Worksheets("Client 1").Range("A:A")

End If End Sub

Since you are asking for a macro, I assume you know where to place the macro and how to run it.

the macro was tested with data that complies with what you described and what I assumed and it worked fine for me.


©2024 eLuminary LLC. All rights reserved.