RE-ORDER and Inserting Columns of two Workbooks.

[maj1c]

Im facing a hard time with a macro Task for ordering columns of one Workbook, in relation to the column order of another Workbook.

It has a higher degree of difficulty of the regular "ordering columns" macro because it is about ordering and inserting new columns, based in the order of another Woorkbook's Headers and preferably not by writing such order in the code itself.

The next table is a shorter summary of the two files I am working with (in total are 30-40 columns). WB1 column headers are shown as (APS, ADA, ROIshort, etc) and so the columns names of WB2.

Culums in the Reference WB1 (master)	Columns in WB2 to reorder
APS	APS
ADA	ADA_SI
ROIshort	ZONE
DS New	Component
Component	Part_Name
NAME_	Code
Station	ROI_Short
Zone

The first Problem is that the headers dont even match. I do not if I should stop right here and say that I cannot be done until the files contain the same headers.

The second problem is that some columns do not exist in the other WB (marked in red). When there is a column in the Reference file that do not exist in the "slave", I have to insert a BLANK column in its place. When there is a column in the "slave" that do not exist in the "master", it should only be moved at the end of the table.

Culums in the Reference WB (master)	Columns in WB to reorder (slave)	EXPECTED ORDERED FILE
APS	APS	APS
ADA	ADA_SI	ADA_SI
ROI_Kurz	ZONE	ROI_Short
DS New	Component	BLANK COLUMN
Component	Part_Name	Component
NAME_	Code	Part_Name
Station	ROI_Short	BLANK COLUMN
Zone		ZONE
		Code

Since I am a true beginner, I have had some hard time even thinking how to start. I think it is a Little overwhelming and I would really appreciate help or guidance.

Thank you in advance!

[SamT]

based in the order of another Woorkbook's Headers and preferably not by writing such order in the code itself.

Surely, you jest.

Create a Workbook with three sheets. Name the Sheets, "WB1", "WB2", and "Desired"

Insert all the headers for all three situations. Leave the rest of the sheet(s) blank. Color the Headers in WB1, (Master) that should be blank columns,

In our Forum, use the Go Advanced button, and at the bottom of that page, use the Manage Attachments button to upload the example book you created.

Note that any solution will probably use a "Desired" sheet in addition to the WB2, (Slave) sheet.

We will also need the Name of the Workbook that will hold this code and the name and path of the other Workbook, and which is "Slave" and which is "Master."

nb, "Master" = Source, and "Slave" = Destination.

One last Question: Do any columns need to be copied from one book to the other?

[maj1c]

Thank you for the Response SamT,

I tried to attach the example workbook but I could not do it (There is a red exclamation mark in the upload box.)


In the meantime, maybe it could be useful to share a drive link with the file:

https://drive.google.com/file/d/1suf9hO971cjKuGAUeI2SRTC1A6dOP-WS/view?usp=drivesdk

We will also need the Name of the Workbook that will hold this code and the name and path of the other Workbook, and which is "Slave" and which is "Master."

nb, "Master" = Source, and "Slave" = Destination.

One last Question: Do any columns need to be copied from one book to the other?

Name of the workbook = ColumnOrder.xlsb

Path of files:

"C:\Users\THD3WE\Desktop\Tasks\Ordering Columns\MasterFile.xlsb"
"C:\Users\THD3WE\Desktop\Tasks\Ordering Columns\ToBeModified.csv"
"C:\Users\THD3WE\Desktop\Tasks\Ordering Columns\ColumnOrder.xlsb"

No, the columns do not have to be copied from one book to another.


thank you in advance for the time invested in this

[MINCUS1308]

Do your days at work normally go like:
Boss: "Match these things that don't match, Oh also put those things that don't match in order"

If anyone can do it SamT can.
I think you're going to need similar headers or some creative use of the 'Like' statement.
I'm excited to see what SamT comes up with.

[maj1c]

Do your days at work normally go like:
Boss: "Match these things that don't match, Oh also put those things that don't match in order"

I really hope this is an odd-one and they dont require that kind of task anymore. I have been working on it since last thursday and since I am a true beginner in macros, it has been really a pain in the butt because it's a trial-and-error process.

If anyone can do it SamT can.

I certaintly was not expecting such a nice response and that a moderator took the time to see my puny post. I have not been long in this forum but from the way he replied so confident and decided I can see he is truly a pro.

[SamT]

THis code Compiles, but it's obviously not tested.

All this code goes in any workbook that will be open at the same time as the Master and Slave books. Place the code in a Standard Module. Typically, "Module1"

Option Explicit

Const MastBookName = "MasterFile.xlsb"     'Edit to suit"
Const MastShtName = "MasterSheet"          'Edit to suit"

Dim OldSht As Object
Dim NewSht As Object

Public Sub ReArrange_and_Clear_Columns()
'This assumes that you have opened the Master Book
'And have Opened the CSV file as new Excel book
'AND the CSV Book is the Active book

Set OldSht = ActiveSheet

'Run Subs:
  BlankColumns
  AddNewSheet
  MoveColumns
End Sub

Sub BlankColumns()
Dim Headers As Variant
Headers = Array("DS New/Reuse", "ComponentATA", "PART_STATUS", "Part NEW/REUSED", "Industrialisierung", "K_DISPO_", _
"STATION_PDA", "LaborCode", "ProdType", "ReportingCenter Team", "Requirement PoE")
Dim Found As Range
Dim i As Long

Application.ScreenUpdating = False

For i = 1 To UBound(Headers)
  With Workbooks(MastBookName).Sheets(MastShtName).Rows(1)
    Set Found = .Find(Headers(i))
    If Not Found Is Nothing Then Intersect(Found.EntireColumn, .UsedRange).Offset(1).Clear
  End With
Next

Application.ScreenUpdating = True

End Sub

Sub AddNewSheet()
Dim Sht As Worksheet
Dim Headers As Variant
Headers = Array("MSN", "Section_Short", "Used_ATA", "ADAP_CI", "ADAP_DS", "DS_State", "", "", "Component", "Component_NAME", _
"", "", "Component_Type", "Quantity_per_DS", "", "", "Station", "", "", "", "CA_Code", "Requirement_Name", _
"Requirement_State", "TechnoCode", "ATA_ZONE", "DS_Title", "DS_Issue", "DS_IPT", "DS_Team", "", _
"NSPI Standardisation Status", "NSPI Qualification comments", "NSPI Best Qual P-Status", "NSPI Best Qual E-Status", _
"Component_Release_Date", "DS_PoE", "DS_Version", "CI_Title", "", "Component_STATE", "Component_level", _
"Component_Lead_Time", "DS_Domain", "MERCode", "DORCode", "Natco Supply Code", "Natco Supplier Name")

Application.ScreenUpdating = False

With ActiveWorkbook
  .Sheets.Add
  Set NewSht = .ActiveSheet
  NewSht.Range("A1").Resize(1, 47).Value = Headers
End With

Application.ScreenUpdating = True
End Sub

Sub MoveColumns()
Dim Cel As Range
Dim Found As Range
Dim Headers As Range

Application.ScreenUpdating = False

With OldSht
  Set Headers = .Intersect(.Rows(1), .UsedRange)
End With

With NewSht
   For Each Cel In .Intersect(.Rows(1), .UsedRange)
    If Not Cel = "" Then
      Set Found = Headers.Find(Cel)
      If Not Found Is Nothing Then _
        Found.EntireColumn.Copy Destination:=Cel
    End If
  Next
End With

Application.DisplayAlerts = False
'OldSht.Delete ''''Uncomment this line after testing

With Application
  .DisplayAlerts = True
  .ScreenUpdating = True
End With
End Sub

[maj1c]

THis code Compiles, but it's obviously not tested.

All this code goes in any workbook that will be open at the same time as the Master and Slave books. Place the code in a Standard Module. Typically, "Module1"

Option Explicit

Const MastBookName = "MasterFile.xlsb"     'Edit to suit"
Const MastShtName = "MasterSheet"          'Edit to suit"

Dim OldSht As Object
Dim NewSht As Object

Public Sub ReArrange_and_Clear_Columns()
'This assumes that you have opened the Master Book
'And have Opened the CSV file as new Excel book
'AND the CSV Book is the Active book

Set OldSht = ActiveSheet

'Run Subs:
  BlankColumns
  AddNewSheet
  MoveColumns
End Sub

Sub BlankColumns()
Dim Headers As Variant
Headers = Array("DS New/Reuse", "ComponentATA", "PART_STATUS", "Part NEW/REUSED", "Industrialisierung", "K_DISPO_", _
"STATION_PDA", "LaborCode", "ProdType", "ReportingCenter Team", "Requirement PoE")
Dim Found As Range
Dim i As Long

Application.ScreenUpdating = False

For i = 1 To UBound(Headers)
  With Workbooks(MastBookName).Sheets(MastShtName).Rows(1)
    Set Found = .Find(Headers(i))
    If Not Found Is Nothing Then Intersect(Found.EntireColumn, .UsedRange).Offset(1).Clear
  End With
Next

Application.ScreenUpdating = True

End Sub

Sub AddNewSheet()
Dim Sht As Worksheet
Dim Headers As Variant
Headers = Array("MSN", "Section_Short", "Used_ATA", "ADAP_CI", "ADAP_DS", "DS_State", "", "", "Component", "Component_NAME", _
"", "", "Component_Type", "Quantity_per_DS", "", "", "Station", "", "", "", "CA_Code", "Requirement_Name", _
"Requirement_State", "TechnoCode", "ATA_ZONE", "DS_Title", "DS_Issue", "DS_IPT", "DS_Team", "", _
"NSPI Standardisation Status", "NSPI Qualification comments", "NSPI Best Qual P-Status", "NSPI Best Qual E-Status", _
"Component_Release_Date", "DS_PoE", "DS_Version", "CI_Title", "", "Component_STATE", "Component_level", _
"Component_Lead_Time", "DS_Domain", "MERCode", "DORCode", "Natco Supply Code", "Natco Supplier Name")

Application.ScreenUpdating = False

With ActiveWorkbook
  .Sheets.Add
  Set NewSht = .ActiveSheet
  NewSht.Range("A1").Resize(1, 47).Value = Headers
End With

Application.ScreenUpdating = True
End Sub

Sub MoveColumns()
Dim Cel As Range
Dim Found As Range
Dim Headers As Range

Application.ScreenUpdating = False

With OldSht
  Set Headers = .Intersect(.Rows(1), .UsedRange)
End With

With NewSht
   For Each Cel In .Intersect(.Rows(1), .UsedRange)
    If Not Cel = "" Then
      Set Found = Headers.Find(Cel)
      If Not Found Is Nothing Then _
        Found.EntireColumn.Copy Destination:=Cel
    End If
  Next
End With

Application.DisplayAlerts = False
'OldSht.Delete ''''Uncomment this line after testing

With Application
  .DisplayAlerts = True
  .ScreenUpdating = True
End With
End Sub

Thank you very much for such an effort! I will test it as soon as I can access to the work files tomorrow at the office. I can see so many functions that I did not even know existed. I will carefully read and analyse each one of them.

Really thank you

[SamT]

Most of that "Work," such as the Arrays, was just a matter of a few mouse clicks. If you get serious about coding, any language, I highly recommend UltraEdit. It beats Ctrl+H and Ctrl+F all to pieces.

[maj1c]

Most of that "Work," such as the Arrays, was just a matter of a few mouse clicks. If you get serious about coding, any language, I highly recommend UltraEdit. It beats Ctrl+H and Ctrl+F all to pieces.

Thanks for the tip, I will have to download in my personal computer, since the one at the office does not let me.

I was trying to run the macro by pasting the code in a new book and, while being in the .CSV book, run the macro "ReArrange_and_Clear_Columns". However, it did not let me arrange it because of an error: run time error 438

I tried to look at the code and it was telling me do debug a line marked in yellow:

If Not Found Is Nothing Then Intersect(Found.EntireColumn, .UsedRange).Offset(1).Clear

I check the expresion and I could not find anything wrong with it. Do you have any idea what is happening?

[SamT]

The highlighted line is the next line to execute. There might be a previous issue that won't allow that line to run.

I don't know what edits you made to the code, nor which Code Module you placed the code in.

Try clicking F8 to Step thru the Code. Open all the relevant workbooks, then View the CSV sheet. From there open the VBA Editor and place the cursor inside Sub ReArrange_and_Clear_Columns and click F8 repeatedly.

If you hover the mouse over any Objects, Ranges, or variables after the relevant line has run, you will see the value of that variable

run time error 438

Sorry, I have not yet memorized the texts of all 9999 error numbers in Excel

[MINCUS1308]

hahaha SamT's so good he never gets that error! Object doesn't support that property - lol I get one that all the time.
SamT is right, you'll have to step through the code like Sherlock Holmes before a fight.
maj1c, Perhaps if you posted the file we could help with the debugging process.

[maj1c]

Sorry for not being specific about it, I did not pretend you to know the code number by heart of course, my fault for not specifying.

What I have done is the following:

Rename my original Master-Slave files and sheets to "MasterFile.xlsb/MasterSheet" and "TobeModified.csv/ToBeModified".

• Created a new book "Book1" and inserted a new Module where I pasted the code.

• MODIFICATION in sub BlankColumns: in the "For i=1 To UBOUND(Headers)" I changed i=0, since I realized it was not starting from the first column.

• Selected the CSV book -> run the macro "ReArrange_and_Clear_Columns"

The code do not compiles and ask me to debug. I have google the error code and it is some problem with the temp files. I follow instructions and it was fixed, but the code does not run still. it asks me to debug the line

 If Not Found Is Nothing Then Intersect(Found.EntireColumn, .UsedRange).Offset(1).Clear

I have try the F8 method, but I do not understant the function Intersect, part where is the problem.

Am I doing something wrond with the naming or order or steps?

Option Explicit

Const MastBookName = "MasterFile.xlsb"     'Edit to suit"
Const MastShtName = "MasterSheet"          'Edit to suit"

Dim OldSht As Object
Dim NewSht As Object

Public Sub ReArrange_and_Clear_Columns()
'This assumes that you have opened the Master Book
'And have Opened the CSV file as new Excel book
'AND the CSV Book is the Active book
Set OldSht = ActiveSheet
'Run Subs:
  BlankColumns
  AddNewSheet
  MoveColumns
  
End Sub
Sub BlankColumns()
Dim Headers As Variant
Headers = Array("DS New/Reuse", "ComponentATA", "PART_STATUS", "Part NEW/REUSED", "Industrialisierung", "K_DISPO_", _
"STATION_PDA", "LaborCode", "ProdType", "ReportingCenter Team", "Requirement PoE")
Dim Found As Range
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To UBound(Headers)
  With Workbooks(MastBookName).Sheets(MastShtName).Rows(1)
    Set Found = .Find(Headers(i))
    If Not Found Is Nothing Then Intersect(Found.EntireColumn, .UsedRange).Offset(1).Clear
  End With
Next

Application.ScreenUpdating = True
End Sub

Sub AddNewSheet()
Dim Sht As Worksheet
Dim Headers As Variant
Headers = Array("MSN", "Section_Short", "Used_ATA", "ADAP_CI", "ADAP_DS", "DS_State", "", "", "Component", "Component_NAME", _
"", "", "Component_Type", "Quantity_per_DS", "", "", "Station", "", "", "", "CA_Code", "Requirement_Name", _
"Requirement_State", "TechnoCode", "ATA_ZONE", "DS_Title", "DS_Issue", "DS_IPT", "DS_Team", "", _
"NSPI Standardisation Status", "NSPI Qualification comments", "NSPI Best Qual P-Status", "NSPI Best Qual E-Status", _
"Component_Release_Date", "DS_PoE", "DS_Version", "CI_Title", "", "Component_STATE", "Component_level", _
"Component_Lead_Time", "DS_Domain", "MERCode", "DORCode", "Natco Supply Code", "Natco Supplier Name")
Application.ScreenUpdating = False
With ActiveWorkbook
  .Sheets.Add
  Set NewSht = .ActiveSheet
  NewSht.Range("A1").Resize(1, 47).Value = Headers
End With
Application.ScreenUpdating = True
End Sub
Sub MoveColumns()
Dim Cel As Range
Dim Found As Range
Dim Headers As Range
Application.ScreenUpdating = False
With OldSht
  Set Headers = .Intersect(.Rows(1), .UsedRange)
End With
With NewSht
   For Each Cel In .Intersect(.Rows(1), .UsedRange)
    If Not Cel = "" Then
      Set Found = Headers.Find(Cel)
      If Not Found Is Nothing Then _
        Found.EntireColumn.Copy Destination:=Cel
    End If
  Next
End With
Application.DisplayAlerts = False
'OldSht.Delete ''''Uncomment this line after testing

With Application
  .DisplayAlerts = True
  .ScreenUpdating = True
End With
End Sub

[SamT]

SamT's so good he never gets that error!

Nah, that's not it. I just never pay attention to numbers.

[SamT]

The problem is in

With Workbooks(MastBookName).Sheets(MastShtName).Rows(1)
    Set Found = .Find(Headers(i))
    If Not Found Is Nothing Then Intersect(Found.EntireColumn, .UsedRange).Offset(1).Clear
  End With

Workbooks(MastBookName).Sheets(MastShtName).Rows(1) does not have a UsedRange

One solution is

With Workbooks(MastBookName).Sheets(MastShtName).Rows(1)
    Set Found = .Find(Headers(i))
    If Not Found Is Nothing Then Intersect(Found.EntireColumn, .CurrentRegion).Offset(1).Clear
  End With

The CurrentRegion of Workbooks(MastBookName).Sheets(MastShtName).Rows(1) is the same as the Sheets UsedRange


But I think this is more elegant

With Workbooks(MastBookName).Sheets(MastShtName)
    Set Found = .Rows(1).Find(Headers(i))
    If Not Found Is Nothing Then Intersect(Found.EntireColumn, .UsedRange).Offset(1).Clear
  End With

Intersect(Found.EntireColumn, .UsedRange) Returns only that Range which is in BOTH UsedRange and That Column. THEN .Offset(1, 0) moves that range down one row, so it's Header is not cleared

[maj1c]

SamT,

You were certaintly right, the code in that part worked. What exactly is the UsedRange and CurrentRegion?

　
I tried to repeat the logic in this solution in another bug in the sub MoveColumns(). however it did not work. In this part the debug option is highlighting again the line with the "intersect" command. I expect that maybe it will Show the same in the second line with the Intersect.
　

With OldSht.Row(1)

  Set Headers = .Intersect(.Rows(1), .UsedRange)
End With

　
With NewSht.Row(1)
   For Each Cel In .Intersect(.Rows(1), .UsedRange)
    If Not Cel = "" Then
      Set Found = Headers.Find(Cel)
      If Not Found Is Nothing Then _
        Found.EntireColumn.Copy Destination:=Cel
    End If

  Next
End With

　
What does the points before every workd means? I always thought of them being an indication that the part that follows them is a subpart/component/attribute of the previous, like Worksheet.Name, but ".intersect" and ".Rows" do not have anything before them. Why is that?
　
P.S. I will upload as soon as I get acces to my computer the three Workbook files I am working with, in case that could help a bit more.

[SamT]

What exactly is the UsedRange and CurrentRegion?

UsedRange is all of the Worfksheet that is "used." It might include cells that you thought were not used, including any cell with any formatting applied.

CurrentRegion is particular to a certain Cell. It is bounded by empty cells.

In a Worksheet,place some values in A1:C3, Place some values in E5:G7, apply any CellFormat to J9

Worksheet.UsedRange = Range("A1:J9")
Range("A1").CurrentRegion = Range("A1:C3")
Range("G7").CurrentRegion = Range("E5:G7")

Place some Values in C4:E4, meaning no empty cells between the two groups
Worksheet.UsedRange = Range("A1:J9")
Range("A1").CurrentRegion = Range("A1:G7")
Range("G7").CurrentRegion = Range("A1:G7")

Even just the corners of two Ranges touching will mean both are part of the same CurrentRegion of all cells in the two groups.

What does the points before every word means? I always thought of them being an indication that the part that follows them is a subpart/component/attribute of the previous,

That is correct, but the "Previous" might be in a With Statement.


Intersect is standalone, It is part of the Application Object. It is a Range. It gets it's Sheet/Range "Parent" from the Ranges in it's Arguments. It never gets a Dot (point)

Rows, without the Dot (Point), is an Application and a Worksheet Term and means that Range of all the rows present on any of that Application version's Worksheets or all the Rows on that particular Worksheet.

Rows, without the Dot can only be used to Count the number of Rows available to all Worksheets in that book's version of Excel.
Sheet Code... Sht.Rows represents the Range of that entire Sheet. Treat it like an Array.

Sht.Rows(3) returns the Range of the Entire third Row.
SomeRange.Rows.Count means the number of Rows in that Range.
SomeRange.Rows(3) represents the entire third Row of that Range

Rows.Count, No Dot before Rows, = The number of Rows present on all Worksheets in that WorkBook Application Version.

If you're working on an xls book from an xlsm book, then you should specify the xls Book with a dot before Rows, Else you will get the Number of Rows in the xlsm book
Workbooks("xlsBook").Rows.Count


SomeRange.Rows.Count means the number of Rows in that Range

[maj1c]

Hello again SamT, other users,

Sorry for not replying and uploading the files, I got a strong flu last week and could not come to work. I am back to my computer just today.

Thank you for the information of the UsedRange and CurrentRegion, was really easy to understand and learn the concept with the example. However, I am not getting how it you are applying it in your code.

In the first correction that you made, how do you know there is no UsedRange. For me, there is, since you are specifying the Workbook and its Row in the “With” statement.

The problem is in

With Workbooks(MastBookName).Sheets(MastShtName).Rows(1)
    Set Found = .Find(Headers(i))
    If Not Found Is Nothing Then Intersect(Found.EntireColumn, .UsedRange).Offset(1).Clear
  End With

Workbooks(MastBookName).Sheets(MastShtName).Rows(1) does not have a UsedRange

Also, in the Sub for MoveColumns(), I go the same error in all the lines with the Intersect(.Rows(1), .UsedRange), but I still cannot find how to solve it. I really do not understand what that statement is doing.

With OldSht.Row(1)
  Set Headers = .Intersect(.Rows(1), .UsedRange)       ‘********************************************
End With
　
With NewSht.Row(1)
   For Each Cel In .Intersect(.Rows(1), .UsedRange)        ‘********************************************
    If Not Cel = "" Then
      Set Found = Headers.Find(Cel)
      If Not Found Is Nothing Then _
        Found.EntireColumn.Copy Destination:=Cel
    End If

  Next
End With

Sorry for asking again, but could you please continuing helping me? I link the files that I am using since I apparently cannot upload anything in the forum:
https://drive.google.com/folderview?...IFxW5Oqn_W1zO4

[SamT]

Let's analyze

With OldSht.Row(1)
  Set Headers = .Intersect(.Rows(1), .UsedRange)       
End With

The With Statement, as you wrote it, should be read as if it was a combination of a Method and two Ranges. (Dots shown as .) Remember, the Dots mean the following is a member of the preceding Object
OldSht.Row(1).Intersect 'Method
OldSht.Row(1).Rows(1) 'Range
OldSht.Row(1).UsedRange 'Range

The Intersect Method belongs to the Application Object, not a Row (range)
The UsedRange Range Belongs to the Worksheet Object, not a Row (range)
All Ranges, From a Single Cell to the entire Worksheet, do have a Rows(1) (range)

Since Intersect and UsedRange are members of only a single Object, they do not require Dots because there is no confusion about which Object's Member to use.

I would write that code snippet as

With OldSht
  Set Headers = Intersect(.Rows(1), UsedRange)       
End With

Written in complete verbosity, but still valid code

Set Headers =Application.Intersect(OldSht.Rows(1), OldSht.UsedRange)

[maj1c]

SamT,


I want to thank you for the help! the macro finallyworks!!

I could fix the macro's bug! and even better, I would say Iunderstand how it works thanks to your Explanation! I really thank you foryour time and patience. Your skills clearly back your reputation up!

Now, in order to finally finish this task, I will just workin small details that are out of the scope of this thread. They are smaller andof basic level so I think I can do the research myself.

I hope my boss doesn’t ask me to do more complicated stufflike this, at least not in the short term. I would like to learn and to betterunderstanding of VBA and I will give it a try with this software you recommendme to learn.

Thanks also to the community!