Find Col and Paste...

m0atz

Board Regular
Joined
Jul 17, 2008
Messages
247
Hi all,

I have minor prob which I'm sure will be an easy fix...

Currently there are 3 sheets in my wbook, however there are likely to be 30 or so soon enough. Each sheet has loads of Cols of data and no sheet is generally the same.

I'm after my "Control" sheet to display a replica of the columns entitled "Destination" found in all other wsheets. i.e. each sheet has a destination col and I need an automated way of getting these lists side by side.

The challenge I'm faced with is that the destination col in each sheet is never usually in the same column, i.e. sheet1 could be colA, sheet2 colB etc and each sheet might contain more than one destination col,

Can anyone help?

cheers

colin
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
This code puts the sheet name in row 1 and the column number in row 2 then copies the first 65533 lines of that column to row 3 and below on the control worksheet.

EXISITNG DATA ON CONTROL WORKSHEET WILL BE ERASED WHEN THIS CODE IS RUN

Code:
Sub CopyDestinationColumns()
    Dim intX As Integer
    Dim intY As Integer
    Dim intColumn As Integer
    Dim intDestinationCount As Integer
    Dim intControlColumnToWrite As Integer
    Dim cFind
 
    Worksheets("Control").Cells.Clear
    intControlColumnToWrite = 1
    For intX = 1 To Worksheets.Count
        Worksheets(intX).Select
        If Worksheets(intX).Name <> "Control" Then
            With Worksheets(intX).Rows(1)
                intDestinationCount = Application.WorksheetFunction.CountIf(Rows(1), "Destination")
                Set cFind = .Find("Destination", after:=Cells(1, 256))
                intY = 0
                Do While Not cFind Is Nothing
                    Worksheets("Control").Cells(1, intControlColumnToWrite) = Worksheets(intX).Name
                    Worksheets("Control").Cells(2, intControlColumnToWrite) = cFind.Column
                    Worksheets(intX).Range(Cells(1, cFind.Column), Cells(65533, cFind.Column)).Copy _
                        Destination:=Worksheets("Control").Cells(3, intControlColumnToWrite)
                    intControlColumnToWrite = intControlColumnToWrite + 1
                    Set cFind = .FindNext(cFind)
                    intY = intY + 1
                    If intY = intDestinationCount Then Exit Do
                Loop
            End With
        End If
    Next
 
    Worksheets("Control").Select
    Cells.Columns.AutoFit
    Range("A1").Select
End Sub
 
Upvote 0
Perhaps i spoke too soon...for some reason I'm getting "Subscript Out of Range" when i add this macro to my personal.xls code. I can't work out what reference its not picking up (all my workbooks i create have a worksheet called control??)

Cheers

col
 
Upvote 0
I copied my original code to my personal.xls and it ran as expected. The only time I got a "Subscript out of Range" error was when there was no 'Control' worksheet in the workbook. Here is a version with a check for the 'Control' worksheet.

Code:
Sub CopyDestinationColumns()
    Dim intX As Integer
    Dim intY As Integer
    Dim intColumn As Integer
    Dim intDestinationCount As Integer
    Dim intControlColumnToWrite As Integer
    Dim cFind
    Dim booFound As Boolean
    
    booFound = False
    For intX = 1 To Worksheets.Count
        If UCase(Worksheets(intX).Name) = "CONTROL" Then
            booFound = True
            Exit For
        End If
    Next
    
    If booFound = True Then
        Worksheets("Control").Cells.Clear
        intControlColumnToWrite = 1
        For intX = 1 To Worksheets.Count
           Worksheets(intX).Select
           If Worksheets(intX).Name <> "Control" Then
               With Worksheets(intX).Rows(1)
                   intDestinationCount = Application.WorksheetFunction.CountIf(Rows(1), "Destination")
                   Set cFind = .Find("Destination", after:=Cells(1, 256))
                   intY = 0
                   Do While Not cFind Is Nothing
                       Worksheets("Control").Cells(1, intControlColumnToWrite) = Worksheets(intX).Name
                       Worksheets("Control").Cells(2, intControlColumnToWrite) = cFind.Column
                       Worksheets(intX).Range(Cells(1, cFind.Column), Cells(65533, cFind.Column)).Copy _
                           Destination:=Worksheets("Control").Cells(3, intControlColumnToWrite)
                       intControlColumnToWrite = intControlColumnToWrite + 1
                       Set cFind = .FindNext(cFind)
                       intY = intY + 1
                       If intY = intDestinationCount Then Exit Do
                   Loop
               End With
           End If
       Next
    
       Worksheets("Control").Select
       Cells.Columns.AutoFit
       Range("A1").Select
    Else
        MsgBox "No 'Control' worksheet"
    End If
End_Sub:
    Set cFind = Nothing
    
End Sub
 
Upvote 0
This is really weird - the new code says no control worksheet - but there's definitely a sheet there called Control - ! I'm not being thick am i, the sheet doesnt have to be in the personal.xls?
 
Upvote 0
No, the 'Control' worksheet should be in the Active Workbook. Verify that 'Control' is spelled correctly on worksheet tab, with no punctuation or leading or trailing spaces and that it is not set to hidden or very hidden in its properties in VBA window (F4 when sheet is selected in VBAProject window).

Try
Code:
?Activeworkbook.Name  '1
Worksheets("Control").Select  '2
commands in the Immediate window and see if 1) displays the expected workbook name and 2) selects the expected worksheet
 
Upvote 0
I'm afraid to report I'm still having issues with this...

I created a quick sub as suggested,

Code:
sub test()
 
msgbox activeworkbook.name
worksheets("Control").select
 
end sub

and that works fine - it selects the Control sheet - there's definitely no hidden or very hidden properties (in fact its a brand new wbook I've created to try this out).

The code you posted works fine when its in the wbook code window, just not when in the personal.xls - this is so bizarre...!
 
Upvote 0
The code should be in a module in the personal.xls file, I apologize for not mentioning it earlier. If it is in the personal.xls ThisWorkbook code page it will not work, since code in that module is not "aware" of code outside of personal.xls unless it is explicitly defined.
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,943
Members
448,534
Latest member
benefuexx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top