VBA copy column only when value is 1 in row 1

NickvdB

Board Regular
Joined
Apr 30, 2014
Messages
68
Hello,

Excel 2010:
I would like to use a VBA with the following code
Workbooks("AAA.xlsb").Worksheets("BBB").Range("VARIABLE").Copy Destination:=Workbooks("CCC.xlsb").Worksheets("BBB").Range("a1")
the red part should be based on the values of row 1. So as an example following cell values: A1=1 / B1=1 / D1=1 / G1=1
Then I would like to have rows A + B + D + G in the red part.
Hope this makes sense and somebody can help :)
 

Some videos you may like

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

Arithos

Well-known Member
Joined
Aug 14, 2014
Messages
598
Hmm, abit unclear to me. Would you end result be like this?

Workbooks("AAA.xlsb").Worksheets("BBB").Range("ABCD").Copy

?
 

NickvdB

Board Regular
Joined
Apr 30, 2014
Messages
68
I have misused "rows" in the last sentence :(
In the example I would like to have the complete columns A, B, D and G copied, perhaps displayed as followed:
Workbooks("AAA.xlsb").Worksheets("BBB").Range("A:A"&"B:B"&"D:D"&"G:G").Copy
 

Arithos

Well-known Member
Joined
Aug 14, 2014
Messages
598
soo. Range("A:D","G:G") basicly, and you want whatever Column who has the value 1 in the first row to be copied.. Let me draw something up :)
 

NickvdB

Board Regular
Joined
Apr 30, 2014
Messages
68

ADVERTISEMENT

Perfect, thanks in advance!
 

Arithos

Well-known Member
Joined
Aug 14, 2014
Messages
598
This is how I would do it, I look through row 1, for a value = 1, if that exists I move that column..

Code:
Sub sortTest()


LC = Workbooks("AAA.xlsb").Worksheets("BBB").Cells(1, Columns.Count).End(xlToLeft).Column


For i = 1 To LC
    If Cells(1, i).Value = 1 Then
        NC = Workbooks("AAA.xlsb").Worksheets("BBB").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column
        Workbooks("CCC.xlsb").Worksheets("BBB").Columns(NC).Value = Workbooks("AAA.xlsb").Worksheets("BBB").Columns(i).Value
    End If
Next i
End Sub

It will not bring formats with it however, you could amend it like this to get that aswell.

Code:
Sub sortTest()


LC = Workbooks("AAA.xlsb").Worksheets("BBB").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LC
    If Cells(1, i).Value = 1 Then
        NC = Workbooks("AAA.xlsb").Worksheets("BBB").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column
        Workbooks("AAA.xlsb").Worksheets("BBB").Columns(i).Copy Workbooks("CCC.xlsb").Worksheets("BBB").Columns(NC)
    End If
Next i
End Sub

Test them out, and let me know what you think. Both should be quick.
 
Last edited:

NickvdB

Board Regular
Joined
Apr 30, 2014
Messages
68

ADVERTISEMENT

Thanks for the very quick solution, however excel is not happy with it :) VBA (your first solution) ran for minutes and I killed it.
Would it be more quicker to have the columns with value other than 1 removed?
For information the columns have somewhat like 1500 links to other files (already opened with VBA)
 

Arithos

Well-known Member
Joined
Aug 14, 2014
Messages
598
Did you try debugging it? (running through it step by step).

so, basicly copy the sheet, then remove all columns without 1 in them? That could work. ;)
 

Arithos

Well-known Member
Joined
Aug 14, 2014
Messages
598
And, should not take that much time, how many columns will you have to move? You example listed 4. That should not take much time.

And I would suggest using my second solution if you want it to move links to other workbooks. :)
 

Watch MrExcel Video

Forum statistics

Threads
1,109,359
Messages
5,528,226
Members
409,809
Latest member
VICKRAM

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top