create new WS and add Various Columns (Excel 2003 SP3)

[steveh]

Good afternoon

We have a new Customer who will be sending us various workbooks from time to time which contain various worksheets with data from different countries. None of the columns on these worksheets are in the same order but I have been asked to make a mastersheet that will take data from various columns in each of the worksheets. Asking the Customer to conform to a single standard, is, I am told, not an option.

For example each worksheet may have columns that are headed Company, Address, Site etc. etc. but they are in particular order and are in different languages on the various sheets. I had an idea that if I went through each of the worksheets and commonly renamed the columns that I need to English I could then use the macro recorder to copy those columns from each worksheet and then paste them into a new sheet.

I did not meet with much success because each worksheet may contain a varying amount of data and the sheet tabs are never named the samed. Any ideas please

[Jan Karel Pieterse]

Methinks that if you cannot convince your customer to use a standard order of the columns this will prove a rather difficult task...
Alternatively, convince your customer that you need the column headings to be in English (or at least have a fixed row which has your English translations above the localised headings).

[steveh]

Methinks that if you cannot convince your customer to use a standard order of the columns this will prove a rather difficult task...
Alternatively, convince your customer that you need the column headings to be in English (or at least have a fixed row which has your English translations above the localised headings).

Hi Jan Karel

Thank you for your input.

The column headings are not too great a problem as I can manually go in and change them in a short amount of time. What is a problem at the moment is going in and copying and pasting each column into a master record

My idea would be to create a macro which would make a new sheet, add the column headings that would correspond with all other sheets in the workbook and then copy and past the data. My attempt with the macro recorder on only 2 sheets are as below (This is a pretty rubbish macro and is intended to illustrate the overall result more than anything) but the problems with this are

- The macro recorder does not identify the column headings
- The sheet names could be called anything (ActiveWorkbook.Sheets.Select(there will not be any hidden sheets))
- Range - The range on each sheet may vary, using the recorder gives me 'as is' ranges (something like Range(("A2"), Range("A65536").End(xlUp)).Select but I won't know the column names as they will be different in each worksheet)

Code: Select all

Sub CopyColumns()
'
' CopyColumns Macro
' Macro recorded 05/02/2011 by Steve
'
' Keyboard Shortcut: Ctrl+j
'
    Sheets.Add
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Master"
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Site No."
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Name"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Address"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Contact"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Tel"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Fax"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Email"
    Range("A2").Select
    Sheets("Russia").Select
    Range("A2:A22").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("B2").Select
    Sheets("Russia").Select
    Range("C2").Select
    Application.CutCopyMode = False
    Range("F2:F22").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Columns("B:B").EntireColumn.AutoFit
    Range("C2").Select
    Sheets("Russia").Select
    Application.CutCopyMode = False
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    Range("G2:G22").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("D2").Select
    Sheets("Russia").Select
    Application.CutCopyMode = False
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.SmallScroll ToRight:=2
    Range("I2:I22").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("E2").Select
    Sheets("Russia").Select
    Application.CutCopyMode = False
    Range("D2:D22").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("F2").Select
    Sheets("Russia").Select
    Application.CutCopyMode = False
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "7 (3519) 23 66 11" & Chr(10) & "7 (3519) 23 66 08"
    With ActiveCell.Characters(Start:=1, Length:=35).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("E2:E22").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("G2").Select
    Sheets("Russia").Select
    Application.CutCopyMode = False
    Range("H2:H22").Select
    Selection.Cut
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("H3").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    Range("A23").Select
    Sheets("Australia").Select
    Range("A3:A7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("B23").Select
    Sheets("Australia").Select
    Application.CutCopyMode = False
    Range("D3:D7").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("C23").Select
    Sheets("Australia").Select
    Application.CutCopyMode = False
    Range("E3:E7").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("D23").Select
    Sheets("Australia").Select
    Application.CutCopyMode = False
    Range("A1:A2").Select
    ActiveWindow.SmallScroll ToRight:=3
    Range("J3:J7").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("E23").Select
    Sheets("Australia").Select
    Application.CutCopyMode = False
    Range("F3:F7").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("F23").Select
    Sheets("Australia").Select
    Application.CutCopyMode = False
    Range("G3:G7").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("G23").Select
    Sheets("Australia").Select
    Application.CutCopyMode = False
    Range("I3:I7").Select
    Selection.Copy
    Sheets("Master").Select
    ActiveSheet.Paste
    Range("H23").Select
End Sub

[HansV]

You can sort the columns in the right order by creating a custom sort order:

- Create a list of the column headings in the correct (desired) order.
- Select the list.
- Select Tools | Options...
- Activate the Custom Lists tab.
- You'll see NEW LIST followed by the already defined custom lists Mon, Tue, Wed etc.
- Click Import.
- The custom list will be added below the existing ones.
- Note which position it has (if you have never defined custom lists before, it'll be #6, after NEW LIST, 2 lists with day names and 2 lists with month names).
- Click OK.

You can now sort data by your custom sort order:
- Select the range to be sorted.
- Select Data | Sort...
- Click Options.
- Under First key sort order, select your custom sort order.
- Under Orientation, click Sort left to right.
- Click OK.

It is also possible to use the custom sort order in VBA, by specifying the OrderCustom argument of the Sort method. This must be the position number of the custom list that you noted above. For example (this is air code!):

Code: Select all

  With Worksheets("Russia")
    .UsedRange.Sort Key1:=.Range("A1"), OrderCustom:=6, Orientation:=xlLeftToRight
  End With

[steveh]

You can sort the columns in the right order by creating a custom sort order:

- Create a list of the column headings in the correct (desired) order.
- Select the list.
- Select Tools | Options...
- Activate the Custom Lists tab.
- You'll see NEW LIST followed by the already defined custom lists Mon, Tue, Wed etc.
- Click Import.
- The custom list will be added below the existing ones.
- Note which position it has (if you have never defined custom lists before, it'll be #6, after NEW LIST, 2 lists with day names and 2 lists with month names).
- Click OK.

You can now sort data by your custom sort order:
- Select the range to be sorted.
- Select Data | Sort...
- Click Options.
- Under First key sort order, select your custom sort order.
- Under Orientation, click Sort left to right.
- Click OK.

It is also possible to use the custom sort order in VBA, by specifying the OrderCustom argument of the Sort method. This must be the position number of the custom list that you noted above. For example (this is air code!):

Code: Select all

  With Worksheets("Russia")
    .UsedRange.Sort Key1:=.Range("A1"), OrderCustom:=6, Orientation:=xlLeftToRight
  End With

Thanks Hans

I didn't know that you could sort like that, another good lesson learned

When I run the code below with one named sheet it works fine but if I try and run it on all of the sheets it fails, have you any idea why please?

Code: Select all

Sub CustomSort()
Sheets.Select
    Cells.Select
        Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=6, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal
End Sub

[StuartR]

Why not run it on one sheet at a time.

(air code)

Code: Select all

    Dim sht As Worksheet

    For Each sht In ActiveWorkbook.Worksheets
        sht.Sort...
        ...
    Next sht

[steveh]

Why not run it on one sheet at a time.

(air code)

Code: Select all

    Dim sht As Worksheet

    For Each sht In ActiveWorkbook.Worksheets
        sht.Sort...
        ...
    Next sht

Hi Stuart

If I amend the code as suggested (please see below) it only sorts the worksheet that I am in, my intention was to creat a button that would run the macro and sort all of the sheets? I think maybe I am missing something

Code: Select all

Sub CustomSort()
Dim sht As Worksheet
    For Each sht In ActiveWorkbook.Worksheets
    Cells.Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=6, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal
        Next
End Sub

[StuartR]

...
If I amend the code as suggested (please see below) it only sorts the worksheet that I am in
...

That's because you're code has Selection.Sort, rather than using the variable sht
Try this code...

Code: Select all

Dim sht As Worksheet
    For Each sht In ActiveWorkbook.Worksheets
    sht.UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=6, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal
        Next
End Sub

[steveh]

...
If I amend the code as suggested (please see below) it only sorts the worksheet that I am in
...

That's because you're code has Selection.Sort, rather than using the variable sht
Try this code...

Code: Select all

Dim sht As Worksheet
    For Each sht In ActiveWorkbook.Worksheets
    sht.UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=6, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal
        Next
End Sub

Thanks Stuart

However that still stops and highlights the rows from sht. through to xlSortNormal?

[StuartR]

That is strange.
I wonder if the Key1:=Range("A1") is using the range on the currently selected sheet, instead of the range on the target sheet. Could you please try replacing

Code: Select all

sht.UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=6, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal

with

Code: Select all

sht.UsedRange.Sort Key1:=sht.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=6, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal

to see if that works.

[steveh]

That is strange.
I wonder if the Key1:=Range("A1") is using the range on the currently selected sheet, instead of the range on the target sheet. Could you please try replacing

Code: Select all

sht.UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=6, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal

with

Code: Select all

sht.UsedRange.Sort Key1:=sht.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=6, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal

to see if that works.

Hi Sturat

Perfect, Thank you