Column labeling by a name

Solved
Tom 44 Posted messages 47 Status Member -  
yg_be Posted messages 23437 Registration date   Status Contributor Last intervention   -
Hello everyone,

I am facing a little programming issue:

I need to retrieve data from a file (A) to transpose it to a tracking file (B).
So far, no particular issues...
However, the number and position of the columns in (A) vary from week to week, which makes it difficult for me to retrieve my data easily.

I was wondering if it was possible to "index" the columns not by their position in the sheet (A=1, B=2,...) but by testing for a name to search for in a row?
Indeed, each column has a "title" that will never change, and all these titles will consistently remain in the same row.

Do you have any suggestions for my problem?

Thanking the community in advance.
Best regards,

19 answers

melanie1324 Posted messages 1561 Status Member 156
 
Hello,

you can definitely search as you mentioned using what is called a variable:

sub variable

dim column, row as variant

row = 2
column = 1
do while cells (row, column) <> "title" ' as long as the cell at row 2 and column 1 is different from title

column = column +1 'we add 1 to column to move to the next column
loop

a=magbox("The column where the title is located is " & column)
1
Jerome
 

Hello,

I see this post 9 years late, but I'm still trying :-)

I tried your code and it works very well. However, I am not interested in having the info in a msgbox. What I would like is that as soon as it finds my "title" via the loop, it selects the entire column so that I can rename it?

dim column, row as variant

row = 1
column = 1
do while cells (row, column) <> "title" ' as long as the cell in row 2 and column 1 is different from title

column = column +1 'we add 1 to column to move to the next column
loop

a=magbox("The column where the title is located is " & column)

Thank you for your help

Best regards

0
yg_be Posted messages 23437 Registration date   Status Contributor Last intervention   1 588 > Jerome
 

Hello,

It is better to start a new discussion, in which you will explain, among other things, what you mean by "renaming a column."

0
Tom 44 Posted messages 47 Status Member
 
Hello Mélanie,

Thank you for the tip.
Will this allow me to enable this column so that I can retrieve the data I am looking for?

Thank you in advance.
0
melanie1324 Posted messages 1561 Status Member 156
 
Hello,

you can do whatever you want by reusing the variable column afterwards, example:

sub variable

dim column, row as variant
sheets("Sheet1").select
row = 2
column = 1
do while cells(row, column) <> "title" ' as long as the cell located in row 2 and column 1 is different from title

column = column + 1 ' we add 1 to column to move to the next column
loop

columns(column).copy sheets("Sheet2").columns(1)
' copy the column defined in the variable column to sheet2 column 1
end sub
0
Tom 44 Posted messages 47 Status Member
 
Hello,

Thanks for the info.
However, I was wondering if it is possible to "store" several columns defined by as many "titles" and then use them in a macro like this:

Building = 'data to be retrieved from the stored column no. 1
Workbooks(A_wbook).Activate
Sheets("XX").Activate 'to be defined based on the target sheet name
Cells(Liga, 1) = Building 'to be defined based on the target column number
Workbooks(B_wbook).Activate

Address = 'data to be retrieved from the stored column no. 2
Workbooks(A_wbook).Activate
Sheets("XX").Activate 'to be defined based on the target sheet name
Cells(Liga, 1) = Building 'to be defined based on the target column number
Workbooks(B_wbook).Activate

Etc...

Knowing that the A & B workbooks are already defined, as well as the ranges of rows to be filled.

Thanks again for your valuable help.
0
melanie1324 Posted messages 1561 Status Member 156
 
Hello,

you can definitely act like that.
That seems right to me.
0
Tom 44 Posted messages 47 Status Member
 
Sure, I'll try something during the day.

However, do you think it is necessary to go through mandatory "buffer" copying of the columns as you programmed earlier, or is it possible to store them "in memory" and recall them on the fly?

If that’s the case, could you clarify the procedure to follow?

Thanks again for your help.
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
Hello,

I propose a small variation...

A code that names all columns based on the content of the title row:
Sub NommeColonnes()
Dim intCol As Integer, intDrCol As Integer, byLig As Byte

'The number of the row containing the titles:
byLig = 3
'The number of the last column in which row "byLig" is non-empty:
intDrCol = Cells(byLig, Cells.Columns.Count).End(xlToLeft).Column
'Loop from the 1st column (Column A) to the last (calculated above)
For intCol = 1 To intDrCol
ActiveWorkbook.Names.Add Name:=Cells(byLig, intCol).Value, RefersTo:="=" & ActiveSheet.Name & "!" & Columns(intCol).Address
Next intCol
End Sub
Note: the title row here is row 3, to be adjusted.

Then, for your copy-paste, you just need to specify the name of the column to copy...
Example of copying and pasting the named column Magic to sheet Feuil2 column A:
Sub CopieColle()
Range("Magie").Copy Sheets("Feuil2").Range("A1")
End Sub


--
Best regards,
Franck
0
Tom 44 Posted messages 47 Status Member
 
Thank you for the code, but I don't think it suits my situation...

However, looking back at your previous posts, I had the following question:

Is it possible for your following code to search for multiple "titles" across different columns in the same row before copying the content of each of them to the next sheet?

Because if I understand your code correctly, it is only possible to search for a single title defined in the variable column.
What I am trying to adapt is not working (multiple "similar" loops in sequence searching for different titles and pasting their content onto another sheet).

sub variable

dim column, line as variant
sheets("Sheet1").select
line = 2
column = 1
do while cells (line, column) <> "title" ' as long as the cell in line 2 and column 1 is different from title

column = column +1 'we add 1 to column to move to the next column
loop

columns(column).copy sheets("Sheet2").columns(1)
' copies the column defined in the variable column to sheet2 column 1
end sub

Do you think this is possible? If so, do you have any ideas to suggest (as you may suspect, my coding level unfortunately remains limited...)

Thank you in advance for your commitment.
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
Thank you for the code, but I don't think it's suitable for my situation...

Have you tried???
0
Tom 44 Posted messages 47 Status Member
 
Yes, exactly.
As I mentioned, I do not have a high level in coding, but apparently the code does not work.
Indeed, when I change the title "Magic" to the one I am looking for, no copy-paste appears.
What seems strange to me is that the first macro does not define the same title (namely "Magic") anywhere.
This probably comes from there... but I might be wrong.
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
Yes.
The first macro I gave you (Sub NommeColonnes()) renames the columns based on the content of their third row (byLig = 3).
You can already start by changing the title row number to byLig = 2...
Then, of the two procedures I gave you, the goal is to combine them into one.
For example:
Sub MaMacroAMoi()
Dim intCol As Integer, intDrCol As Integer, byLig As Byte
Dim tabNomsCol(), intIndic As Integer, intColcolle As Integer

'---------- COLUMN NAMING PROCEDURE-----------
'The number of the row containing the titles:
byLig = 2 'TO BE ADAPTED!!!!
'The number of the last column whose "byLig" row is non-empty:
intDrCol = Cells(byLig, Cells.Columns.Count).End(xlToLeft).Column
'Loop from the 1st column (Column A) to the last (calculated above)
For intCol = 1 To intDrCol
'renames the columns
ActiveWorkbook.Names.Add Name:=Cells(byLig, intCol).Value, RefersTo:="=" & ActiveSheet.Name & "!" & Columns(intCol).Address
Next intCol
'---------------END OF COLUMN NAMING-----------------------

'--------------DEFINITION OF COLUMNS TO COPY------------
'TO BE ADAPTED by placing the header names.........
tabNomsCol = Array("NAME", "FirstName", "Address", "Phone", "City", "PostalCode", "Email")

'--------------COPY-PASTE ---------------------------------
'From which column to paste the data:
intColcolle = 2 'TO BE ADAPTED here we paste starting from column B

For intIndic = 0 To UBound(tabNomsCol)
Range(tabNomsCol(intIndic)).Copy Sheets("Sheet2").Cells(1, intColcolle)
intColcolle = intColcolle + 1
Next intIndic
End Sub

This code, however, has a drawback... It cannot have a space or a hyphen at the beginning of the word in your headers....

But you know, this is just an example, you can very well continue with Melanie's code if you feel better about it...
0
Tom 44 Posted messages 47 Status Member
 
Wouldn't there be something to replace in the following code?

RefersTo:="=" & ActiveSheet.Name & "!"

I think I might have missed something at this level, maybe a reference to the title and the tab?

Thank you in advance for your help.
0
Tom 44 Posted messages 47 Status Member
 
I just tried to adapt your macro to my needs and unfortunately I came across this:

Runtime error '1004':

The entered name is not valid.

Is it because I have "titles" that contain spaces in their name?

Thank you again for all your help.
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
Yes, that's what I was telling you earlier: This code does have a drawback... There cannot be a space or a hyphen at the beginning of the word in your headers....
0
Tom 44 Posted messages 47 Status Member
 
Yes, I understood that the word should not "start" with a space.
Is it also the case if the space is in the middle of the "title", for example: "Id PM"?
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
Ah, I misspoke...
It should be understood as follows:
- The name must not contain spaces (or any other invalid characters)
- The name must start with a letter or an underscore (underscore)
- etc: the name must not conflict with a predefined name in Excel....
0
Tom 44 Posted messages 47 Status Member
 
Thank you for your clarification.

Is it then possible that at the beginning of the code we can use a workaround consisting of replacing all spaces with a sequence of characters (e.g., " " with "$$")?
0
Tom 44 Posted messages 47 Status Member
 


' Replacement of spaces

Sub Replacement()

Cells.Replace What:=" ", Replacement:="$$", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End Sub

Thank you for your expert advice.
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
You can use Replace.
For example, by replacing spaces with nothing (thus removing them):
Replace(bla bla, " ", "")
this would give in your code:
Sub MyMacro()
Dim intCol As Integer, intDrCol As Integer, byLig As Byte
Dim tabNomsCol(), intIndic As Integer, intColcolle As Integer

'---------- COLUMN NAMING PROCEDURE-----------
'The row number containing the titles :
byLig = 2 'TO ADAPT!!!!
'The number of the last column of which row "byLig" is non-empty :
intDrCol = Cells(byLig, Cells.Columns.Count).End(xlToLeft).Column
'Loop from the 1st column (Column A) to the last (calculated above)
For intCol = 1 To intDrCol
' Rename the columns
ActiveWorkbook.Names.Add Name:=Replace(Cells(byLig, intCol).Value, " ", ""), RefersTo:="=" & ActiveSheet.Name & "!" & Columns(intCol).Address
Next intCol
'---------------END COLUMN NAMING-----------------------

'--------------DEFINITION OF COLUMNS TO COPY------------
'TO ADAPT by placing the names of the headers.........
tabNomsCol = Array("NAME", "First Name", "Address", "Phone", "City", "Postal Code", "Email")

'--------------COPY-PASTE ---------------------------------
'From which column to paste the data :
intColcolle = 2 'TO ADAPT here we paste starting from column B

For intIndic = 0 To UBound(tabNomsCol)
Range(tabNomsCol(intIndic)).Copy Sheets("Sheet2").Cells(1, intColcolle)
intColcolle = intColcolle + 1
Next intIndic
End Sub

However, during the copy-paste, it should not be forgotten that the names given to our columns have no spaces... So two choices, either we take this into account in their definition:
tabNomsCol = Array("NAME", "First Name", "Address", "Phone", "City", "PostalCode", "Email")
to be replaced by:
tabNomsCol = Array("NAME", "First Name", "Address", "Phone", "City", "PostalCode", "Email")

Or we go back through a Replace in the line (I haven't tested it):
Range(tabNomsCol(intIndic)).Copy Sheets("Sheet2").Cells(1, intColcolle)
Like this:
Range(Replace(tabNomsCol(intIndic), " ", "")).Copy Sheets("Sheet2").Cells(1, intColcolle)


The ideal being, of course, at the end of the macro, to delete all these names in the workbook, to get a clean code.

Also be careful with the use of ActiveSheet.Name. I don't like that much... The ideal would be to declare, at the beginning of the procedure, a variable of type Worksheet where we would store the object "sheet" concerned by the copy...

I will come back tomorrow to finish this if you don't mind.

--
Sincerely,
Franck
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
Hello,

Here is the complete procedure as a gift:
1- Read the comments carefully,
2- adapt what is indicated
3- Test

Sub MyMacro()
Dim intCol As Integer, intDrCol As Integer, byLig As Byte
Dim tabNomsCol(), intIndic As Integer, intColcolle As Integer
Dim shFeuilAcopier As Worksheet, shFeuilOuColler As Worksheet

'Define the sheet containing the data to copy
Set shFeuilAcopier = Worksheets("Sheet1") '*********TO ADAPT********
'Define the sheet to paste the data
Set shFeuilOuColler = Workbooks("Blabla").Worksheets("Machin") '*********TO ADAPT******** Requires that the workbook blabla is open!

With shFeuilAcopier 'Working with the sheet to copy

'---------- COLUMN NAMING PROCEDURE-----------

'The row number containing the titles:
byLig = 2 '*********TO ADAPT********

'The number of the last column in which the "byLig" row is not empty:
'Note: do not forget the dot before Cells as it relates to shFeuilAcopier
intDrCol = .Cells(byLig, Cells.Columns.Count).End(xlToLeft).Column

'Loop from the 1st column (Column A) to the last (calculated above)
For intCol = 1 To intDrCol
'If the cell in row 2 is not empty:
If .Cells(byLig, intCol) <> "" Then
'Name the columns (Define a name)
ActiveWorkbook.Names.Add Name:=Replace(.Cells(byLig, intCol).Value, " ", ""), _
RefersTo:="=" & shFeuilAcopier.Name & "!" & .Columns(intCol).Address
End If
Next intCol

'---------------END COLUMN NAMING-----------------------

'--------------DEFINITION OF COLUMNS TO COPY------------
tabNomsCol = Array("NAME", "First Name", "Address", "Phone", "City", "Postal Code", "Email") '*********TO ADAPT********
'--------------END DEFINITION------------------------------

'--------------COPY-PASTE --------------------------------

'From which column to paste the data:
intColcolle = 2 '*********TO ADAPT******** here we paste starting from column B

For intIndic = 0 To UBound(tabNomsCol)
.Range(Replace(tabNomsCol(intIndic), " ", "")).Copy shFeuilOuColler.Cells(1, intColcolle)
intColcolle = intColcolle + 1
Next intIndic

'---------------END COPY-PASTE----------------------------

'-------------DELETION OF NAMES-------------------------
For intCol = 1 To intDrCol
'If the cell in row 2 is not empty:
If .Cells(byLig, intCol) <> "" Then
.Range(Replace(.Cells(byLig, intCol).Value, " ", "")).Name.Delete
End If
Next
'-------------END NAME DELETION-------------------------

End With
End Sub


--
Best regards,
Franck
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
Note: I did not study the other characteristics of names (no invalid characters, no conflicts with Excel, etc...).
I only addressed empty cells and those containing spaces...
0
Tom 44 Posted messages 47 Status Member
 
Thank you very much for this professional work.

However, I just adapted your code to my situation and the following code:

Set shFeuilOuColler = Workbooks("Vannes").Worksheets("Feuil1")

It tells me that the index does not belong to the selection... what should I deduce from that?

Thank you for your help.
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
1- The workbook "Vannes" is not open
2- The sheet "Feuil1" does not exist in the workbook "Vannes"
3- There may be a small spelling error in the name of the workbook or sheet (sometimes a space sneaks in incognito in the names)
4- Your Excel may want you to specify the workbook extension .xls, .xlsx
5- etc...
0
Tom 44 Posted messages 47 Status Member
 
It's good, I just managed to figure it out...

However, I think my title line has too many special characters (e.g. N° / dashes as well as apostrophes) and so those lines of code do not validate:

ActiveWorkbook.Names.Add Name:=Replace(.Cells(byLig, intCol).Value, " ", ""), _
RefersTo:="=" & shFeuilAcopier.Name & "!" & .Columns(intCol).Address

Is it possible to combine the "replace" values one after the other?
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
In this case, I recommend using a name validation function.

This function should be placed in the same module as the main subroutine. It is not mandatory but will make things easier. We will pass all the headers as parameters to it. The function will perform all the replacements you want it to make and will return a "valid" name in the main subroutine.

The code for this function:
Function ValideNom(ByVal Nom As String)
Nom = Replace(Nom, "°", "")
Nom = Replace(Nom, "'", "")
Nom = Replace(Nom, " ", "")
Nom = Replace(Nom, "/", "")
Nom = Replace(Nom, "", "")
Nom = Replace(Nom, ":", "")
Nom = Replace(Nom, "*", "")
Nom = Replace(Nom, "?", "")
Nom = Replace(Nom, "|", "")
Nom = Replace(Nom, "<", "")
Nom = Replace(Nom, ">", "")
ValideNom = Nom
End Function
You can add whatever you want in this code...

Calling the function:
Then, the function will be called in the main procedure like this:
ActiveWorkbook.Names.Add Name:=ValideNom(.Cells(byLig, intCol).Value)
or:
.Range(ValideNom(tabNomsCol(intIndic))).Copy
or even:
.Range(ValideNom(.Cells(byLig, intCol).Value)).Name.Delete

The code for the main Sub:
Sub MaMacroAMoi()
Dim intCol As Integer, intDrCol As Integer, byLig As Byte
Dim tabNomsCol(), intIndic As Integer, intColcolle As Integer
Dim shFeuilAcopier As Worksheet, shFeuilOuColler As Worksheet

'Define the sheet containing the data to copy
Set shFeuilAcopier = Worksheets("Feuil1") '*********TO ADAPT********
'Define the sheet to paste the data
Set shFeuilOuColler = Workbooks("Blabla.xls").Worksheets("Machin") '*********TO ADAPT******** Requires that the Blabla workbook is open!

With shFeuilAcopier 'Working with the sheet to copy

'---------- COLUMN NAMING PROCEDURE-----------

'The row number containing the headers:
byLig = 2 '*********TO ADAPT********

'The number of the last column in row "byLig" that is not empty:
'Note: do not forget the dot in front of Cells as it relates to shFeuilAcopier
intDrCol = .Cells(byLig, Cells.Columns.Count).End(xlToLeft).Column

'Loop from the 1st column (Column A) to the last (calculated above)
For intCol = 1 To intDrCol
'If the cell in row 2 is not empty:
If .Cells(byLig, intCol) <> "" Then
'Name the columns (Define a name)
ActiveWorkbook.Names.Add Name:=ValideNom(.Cells(byLig, intCol).Value), _
RefersTo:="=" & shFeuilAcopier.Name & "!" & .Columns(intCol).Address
End If
Next intCol

'---------------END COLUMN NAMING-----------------------

'--------------DEFINITION OF COLUMNS TO COPY------------
tabNomsCol = Array("NOM", "Prénom", "Adresse", "Téléphone", "Ville", "Code Postal", "Mail") '*********TO ADAPT********
'--------------END DEFINITION------------------------------

'--------------COPY-PASTE --------------------------------

'From which column to paste the data:
intColcolle = 2 '*********TO ADAPT******** here we paste starting from column B

For intIndic = 0 To UBound(tabNomsCol)
.Range(ValideNom(tabNomsCol(intIndic))).Copy shFeuilOuColler.Cells(1, intColcolle)
intColcolle = intColcolle + 1
Next intIndic

'---------------END COPY-PASTE----------------------------

'-------------DELETION OF NAMES-------------------------
For intCol = 1 To intDrCol
'If the cell in row 2 is not empty:
If .Cells(byLig, intCol) <> "" Then
.Range(ValideNom(.Cells(byLig, intCol).Value)).Name.Delete
End If
Next
'-------------END DELETION OF NAMES-------------------------

End With
End Sub
0
pijaku Posted messages 13513 Registration date   Status Moderator Last intervention   2 772
 
Hello,

Uhhh...
Thank you???

--
Best regards,
Franck
0
Tom 44 Posted messages 47 Status Member
 
Hello,

Sorry for the delay in my response.
Thank you very much for your work, which works perfectly well, and thank you again for your patience with non-experts (like me...)

See you soon.
0