MACRO Arrange columns in relation to different Woorkbook

[maj1c]

Hello all,

I am new in programming with VBA. I have used this Forum before to help me solve some simple macros and it has been really helpful.

However, right now I am doing a Task that is too complicated for my Level. I hope you can help me, if not to solve the Problem, at least to guide me to find the solution.

I will try to describe the Task as clear as possible:

I have two workbooks: A and B, with only 1 sheet each

• Workbook A is the "master" and its columns headers are in English (Quantity, Colour, Name, Component, Status..etc).

• Workbook B is the file whose columns will be re-arrange in relation to the master's. Such columns are not in the same order than in the "master" and the headers are the literal Translation to spanish (Cantidad, Estado, Componente, Nombre...etc)

• Workbook A (master) has some columns that are not in B, like "Colour". For this situations, my macro should be able to identify that there is not column matching, and insert a blank column in its place.

I have made some Research and found similar Threads regarding arragement of columns, but they are usually arranged in relation to a "fixed" order specify in the code itself and not in relation to the values of another Workbook (whose headers do not even match).

arrColOrder = Array("COLUMN2", "COLUMN4", "COLUMN6", "COLUMN10", "COLUMN1")

https://www.mrexcel.com/forum/excel-questions/606890-reorder-columns-using-macro.html


could you help me or give me advice for this problem? at least to know in which direction I should go or what functions should be useful.

Thank you very much in advance!

 

[ranman256]

do you want all the columns in wb-B to be in the same order as wb-A?

 

[maj1c]

Yes. The Problem is that I dont find a way to link the headers of the columns between the two files if they do not share the headers' names.

 

[Legacy 421546]

You need arrays to translate between the languages. This should get you started:

Option Explicit

Const ENGLISHCOLUMNS = "Quantity,Colour,Name,Component,Status" 'No spaces before or after the strings
Const SPANISHCOLUMNS = "Cantidad,Color,Nombre,Componente,Estado"

Sub test()
    Dim EnglishNames() As String
    Dim SpanishNames() As String
    Dim Count As Integer
    Dim i As Integer
    
    EnglishNames() = Split(ENGLISHCOLUMNS, ",")
    SpanishNames() = Split(SPANISHCOLUMNS, ",")
    
    Count = UBound(EnglishNames)
    For i = 0 To Count
        Debug.Print EnglishNames(i) & " = " & SpanishNames(i)
    Next i
End Sub

Result:
Quantity = Cantidad
Colour = Color
Name = Nombre
Component = Componente
Status = Estado

 

[ranman256]

i added a CONFIG sheet to the English wb.
This sets the order AND translates Eng to Esp.


English ,Spanish
Quantity, Cantidad
Colour,
Name, Nombre
Component, Componente
status, Estado

Sub ArrangeCols()
Dim wbEng As Workbook, wbSpn As Workbook
Dim col As New Collection
Dim vRec, vEng, vSpn, vLtr
Dim sKey As String
Dim c As Integer, i As Integer
Dim bFound As Boolean


Set wbEng = ActiveWorkbook
Set wbSpn = Workbooks("Book2.xls")


   'collect the English/spanish names
wbEng.Activate
Sheets("config").Select
Range("A2").Select
While ActiveCell.Value <> ""
   sKey = ActiveCell.Value
   vRec = sKey & ":" & ActiveCell.Offset(0, 1).Value
   col.Add vRec, sKey     'add col names
   
   ActiveCell.Offset(1, 0).Select 'next row
Wend




    'arrange the spanish sheet
wbSpn.Activate
Range("A1").Select
For c = 1 To col.Count
    vRec = col(c)
    i = InStr(vRec, ":")  'find delimter
    vEng = Left(vRec, i - 1)
    vSpn = Mid(vRec, i)
    If Len(vSpn) = 1 Then
       vSpn = ""
    Else
       vSpn = Mid(vRec, i + 1)
    End If
    
       'find spanish colum
    If vSpn = "" Then
            sKey = Chr(64 + c)
            Columns(sKey & ":" & sKey).Select
            Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(1, c).Value = "[" & vEng & "]"
            'c = c - 1   'adjust for the inserted column
    Else
        Range("A1").Select
        bFound = False
        While ActiveCell.Value <> "" And Not bFound
           If InStr(ActiveCell.Value, vSpn) > 0 Then
               ShiftCol ActiveCell.Column, c
               bFound = True
           End If
           
           ActiveCell.Offset(0, 1).Select      'next column
        Wend
    End If
Next


Set wbEng = Nothing
Set wbSpn = Nothing
End Sub
Private Sub ShiftCol(ByVal pvSrcCol, ByVal pvTargNum)
Dim sScrLtr As String, sTargLtr As String


If pvSrcCol = pvTargNum Then Exit Sub
sScrLtr = Chr(64 + pvSrcCol)
sTargLtr = Chr(64 + pvTargNum)


    Columns(sScrLtr & ":" & sScrLtr).Select
    Selection.Cut
    Columns(sTargLtr & ":" & sTargLtr).Select
    Selection.Insert Shift:=xlToRight
End Sub

 

[maj1c]

Thank you both ranman256 and johnny_j for the Response. I will try to understand the code and try it out to see how it works!

 

[maj1c]

Apparently is too complicated for me. Is there any possibility to solve this Kind of Problem without using the extra Sheet with the configurations?

 

[Legacy 421546]

Yes, if you go with my suggestion and build upon it.

 

[ranman256]

then how will the code know what is english, and what is not?

 

[Legacy 421546]

Master is English as OP described