Aligning randomised worksheet columns

H

HughT

Board Regular
Joined
Jan 6, 2012
Messages
113
Office Version
  1. 365
Platform
  1. Windows
I have to combine several worksheets originally based on standard columns into a single worksheet, but users have randomly included extra columns. So for example if the original headers were:

|Date|Forename|Surname|Address1|Address2|Town|Car user|

Some now have additional columns inserted such as:

|Date|Forename|Surname|Married?|Address1|Address2|Town|Date of Birth|Car user|

Or:

|Date|Forename|Middlename|Surname|Address1|Address2|Town|Car user|Parent?|

How do I capture all the data aligned under the original column headings (so Address1 data will all be in the same column etc), while including the new columns? It doesn't matter where the columns are, providing they are all present.

Many thanks.

HughT
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
This code will combine the data into 1 sheet but only on the headers found on the first sheet

Code: 
Sub CombineData()
'--combines data from all sheets
'  assumes all sheets have exact same header fields as the
'    first sheet; however the fields may be different order.
'--combines using copy-paste. could be modified to pasteValues only


 Dim lNdxSheet As Long, lNextRow As Long, lDestCol As Long
 Dim lColCount As Long, lRowCount As Long
 Dim rHeaders As Range
 Dim sHeader As String
 Dim vMatch As Variant, vHeaders As Variant
 Dim wksCombined As Worksheet


 With Application
   .ScreenUpdating = False
   .DisplayAlerts = False
 End With


 '--add new sheet for results
 Set wksCombined = Worksheets.Add(Before:=Worksheets(1))


 '--optional: delete existing sheet "Combined"
 On Error Resume Next
 Sheets("Master Sheet").Delete
 On Error GoTo 0


 With wksCombined
   .Name = "Master Sheet"
   '--copy headers that will be used in destination sheet
   Set rHeaders = Sheets(2).Range("A1").CurrentRegion.Resize(1)
   rHeaders.Copy Destination:=.Range("A1")
 End With
 '--read headers into array
 vHeaders = rHeaders.Value
 lColCount = UBound(vHeaders, 2)
 lNextRow = 2


 For lNdxSheet = 2 To Sheets.Count
   '--count databody rows of continguous dataset at A1
   lRowCount = Sheets(lNdxSheet).Range("A1").CurrentRegion.Rows.Count - 1
   If lRowCount > 0 Then
      For lDestCol = 1 To lColCount
         sHeader = vHeaders(1, lDestCol)
         '--search entire first col in case field is rSourceData
         vMatch = Application.Match(sHeader, Sheets(lNdxSheet).Range("1:1"), 0)


         If IsError(vMatch) Then
            MsgBox "Header: """ & sHeader & """ not found on sheet: """ _
               & Sheets(lNdxSheet).Name
            GoTo ExitProc
         End If
         With Sheets(lNdxSheet)
         '--copy-paste this field under matching field in combined
           .Cells(2, CLng(vMatch)).Resize(lRowCount).Copy
           '  Option 1: paste values only
           wksCombined.Cells(lNextRow, lDestCol).PasteSpecial (xlPasteValues)


           '  Option 2: paste all including formats and formulas
           '  wksCombined.Cells(lNextRow, lDestCol).PasteSpecial (xlPasteAll)
        End With
      Next lDestCol
      lNextRow = lNextRow + lRowCount
   End If ' lRowCount > 0


 Next lNdxSheet
ExitProc:
 With Application
   .ScreenUpdating = True
   .DisplayAlerts = True
 End With


End Sub
 
Upvote 0
Truiz

Very many thanks, but I couldn't get it to work. I see that you said that it assumes that all sheets have the exact same header rows but in a different order. The problem is that there are random additional columns which need to be included.

Rather than VBA, would it be easier to use multiple lookup type formulas, eg to create a master list of all the headers and then match data from under the same header on the separate worksheets onto the master one? Would require many operations I suppose, but easier to track and trace.

HughT
 
Upvote 0
You could =INDEX(MATCH()) but you will need to have a lookup value i.e Column A should have all the lets say names and then you could go from that
 
Upvote 0
dateforenamesurnameaddr1addr2towncar userDOBmarriedparentdateforenamesurnamemarriedaddr1addr2townDOBcar user
01/10/2017fn1surn1add11add21town1y01/10/2017fn5surn5yadd15add25town504/03/1998n
02/10/2017fn2surn2add12add22town2n02/10/2017fn6surn6nadd16add26town628/03/1998y
03/10/2017fn3surn3add13add23town3n03/10/2017fn7surn7yadd17add27town721/04/1998y
04/10/2017fn4surn4add14add24town4y04/10/2017fn8surn8nadd18add28town815/05/1998n
05/10/2017fn9surn9yadd19add29town908/06/1998n
dateforenamesurnamemarriedaddr1addr2towncar userparent
01/10/2017fn10surn10yadd110add210town10yn
I have added all possible extra columns to the master02/10/2017fn11surn11nadd111add211town11ny
03/10/2017fn12surn12yadd112add212town12yn
the ready to copy table (from the top mixed up database)04/10/2017fn13surn13nadd113add213town13ny
is produced automatically05/10/2017fn14surn14yadd114add214town14yn
06/10/2017fn15surn15yadd115add215town15ny
07/10/2017fn16surn16nadd116add216town16yn
the formula in O38 (resulting in 01/10/2017) is08/10/2017fn17surn17yadd117add217town17ny
09/10/2017fn18surn18nadd118add218town18yn
=IF(ISERROR(OFFSET($N$1,$N38,MATCH(O$37,$O$1:$W$1,0))),"",OFFSET($N$1,$N38,MATCH(O$37,$O$1:$W$1,0)))
this is dragged along and down
I cannot fully automate a process to deal
with both mixed up databases
but this will put each database
into the correct column order
for copying into the master
each database would then be emptied
ready for more names to be addedready to copy table
column O
dateforenamesurnameaddr1addr2towncar userDOBmarriedparent
row 38101/10/2017fn5surn5add15add25town5n04/03/1998y
202/10/2017fn6surn6add16add26town6y28/03/1998n
303/10/2017fn7surn7add17add27town7y21/04/1998y
404/10/2017fn8surn8add18add28town8n15/05/1998n
505/10/2017fn9surn9add19add29town9n08/06/1998y

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col span="2"><col><col><col><col><col></colgroup><tbody>
</tbody>
 
Upvote 0
dateforenamesurnameaddr1addr2towncar userDOBmarriedparentdateforenamesurnamemarriedaddr1addr2townDOBcar user
01/10/2017fn1surn1add11add21town1y101/10/2017fn5surn5yadd15add25town504/03/1998n
02/10/2017fn2surn2add12add22town2n202/10/2017fn6surn6nadd16add26town628/03/1998y
03/10/2017fn3surn3add13add23town3n303/10/2017fn7surn7yadd17add27town721/04/1998y
04/10/2017fn4surn4add14add24town4y404/10/2017fn8surn8nadd18add28town815/05/1998n
01/10/2017fn5surn5add15add25town5n04/03/1998y505/10/2017fn9surn9yadd19add29town908/06/1998n
02/10/2017fn6surn6add16add26town6y28/03/1998n
03/10/2017fn7surn7add17add27town7y21/04/1998y
04/10/2017fn8surn8add18add28town8n15/05/1998n
05/10/2017fn9surn9add19add29town9n08/06/1998y
dateforenamesurnamemarriedaddr1addr2towncar userparent
01/10/2017fn10surn10yadd110add210town10yn
02/10/2017fn11surn11nadd111add211town11ny
03/10/2017fn12surn12yadd112add212town12yn
04/10/2017fn13surn13nadd113add213town13ny
05/10/2017fn14surn14yadd114add214town14yn
06/10/2017fn15surn15yadd115add215town15ny
07/10/2017fn16surn16nadd116add216town16yn
08/10/2017fn17surn17yadd117add217town17ny
09/10/2017fn18surn18nadd118add218town18yn
the macro populates N38, the details are obtained in the correct order and pasted into the master database
at present it only deals with the first table
column O
dateforenamesurnameaddr1addr2towncar userDOBmarriedparent
row 38505/10/2017fn9surn9add19add29town9n08/06/1998y
this is the macro
Sub Macro4()
'
' Macro4 Macro
' Macro recorded 08/11/2017 by bob
'
'
For j = 1 To 5
Cells(38, 14) = j
Range("O38:X38").Select
Selection.Copy
Cells(1, 1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Next j
999 End Sub

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col span="2"><col><col><col><col><col span="2"></colgroup><tbody>
</tbody>
 
Upvote 0
Wow! Thank you very much!

I think I will stick with the formula version because this has to be repeated by someone who doesn't understand VBA.

For clarity, what are the column letters? As I understand it, the 'ready to copy table' includes all the column header titles, and the formula will look up the data from the other tables, including the extra columns. Is the assumption that all the other tables are aligned in the same column, so that the date column is column N? Does the 'ready to copy table' have to have the column of numbers 1-5 (etc) added to make it work?

Sorry for all the questions, but this is really helpful!

H
 
Upvote 0
Although you appear to be going for a Formula solution, you might like to try the code below.
You will need to replace the sheet names in the array "Sht", at the top of the code to the names of the sheet you wish to loop through.
The code should combine all Sheet headers into a Unique array, with all the sheet data from each sheet, placed below the appropriate header name.
The results should show on sheet2.
Code: 
[COLOR=navy]Sub[/COLOR] MG09Nov02
[COLOR=navy]Dim[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Hd [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Sht [COLOR=navy]As[/COLOR] Variant, Hds() [COLOR=navy]As[/COLOR] Variant, uBd [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Shts [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] K [COLOR=navy]As[/COLOR] Variant, Txt [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] p [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] uDic [COLOR=navy]As[/COLOR] Variant
c = 0
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
[COLOR=navy]Set[/COLOR] uDic = CreateObject("scripting.dictionary")
  uDic.CompareMode = vbTextCompare
  
  '[COLOR=green][B]Change sheet Names in "Array" below for all the sheet to loop through.[/B][/COLOR]
  Sht = Array("Sheet4", "Sheet5", "Sheet6")
[COLOR=navy]
For[/COLOR] Hd = 0 To UBound(Sht)
Ray = Sheets(Sht(Hd)).Cells(1).CurrentRegion
    [COLOR=navy]For[/COLOR] n = 1 To UBound(Ray, 2)
        [COLOR=navy]If[/COLOR] Not .Exists(Ray(1, n)) [COLOR=navy]Then[/COLOR]
            p = p + 1
            .Add Ray(1, n), p
        [COLOR=navy]End[/COLOR] If
        [COLOR=navy]If[/COLOR] Not uDic.Exists(Sht(Hd) & Ray(1, n)) [COLOR=navy]Then[/COLOR]
            uDic.Add Sht(Hd) & Ray(1, n), n
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] n
oMax = Application.Max(oMax, UBound(Ray, 1)) + 1
[COLOR=navy]Next[/COLOR] Hd

c = 0
ReDim nray(1 To oMax, 1 To .Count + 1)
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    c = c + 1
 nray(1, c) = K
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]Dim[/COLOR] Dic [COLOR=navy]As[/COLOR] Object
[COLOR=navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
c = 1
[COLOR=navy]
For[/COLOR] Hd = 0 To UBound(Sht)
Ray = Sheets(Sht(Hd)).Cells(1).CurrentRegion
[COLOR=navy]For[/COLOR] n = 2 To UBound(Ray, 1)
   Txt = Ray(n, uDic(Sht(Hd) & "Forename")) & Ray(n, uDic(Sht(Hd) & "Surname"))
    [COLOR=navy]If[/COLOR] Not Dic.Exists(Txt) [COLOR=navy]Then[/COLOR]
      c = c + 1
      Dic.Add Txt, c
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]Next[/COLOR] Hd
[COLOR=navy]
For[/COLOR] Hd = 0 To UBound(Sht)
    Ray = Sheets(Sht(Hd)).Cells(1).CurrentRegion
    [COLOR=navy]For[/COLOR] n = 2 To UBound(Ray, 1)
       [COLOR=navy]For[/COLOR] Ac = 1 To UBound(Ray, 2)
            Txt = Ray(n, uDic(Sht(Hd) & "Forename")) & Ray(n, uDic(Sht(Hd) & "Surname"))
            nray(Dic(Txt), .Item(Ray(1, Ac))) = Ray(n, Ac)
        [COLOR=navy]Next[/COLOR] Ac
   [COLOR=navy]Next[/COLOR] n
[COLOR=navy]Next[/COLOR] Hd
[COLOR=navy]End[/COLOR] With
[COLOR=navy]
With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, UBound(nray, 2))
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
my approach will accept colums in any order eg DOB could be column 1

I take the "mixed" tables and line by line put them in the right order (using helper cells) and copy them into the master table.....

eg in post 6 fn9 on row 38 is there as the result of an offset(match,match) formula....
 
Upvote 0
Thank you so much for your responses.

Some genius has now rejigged the latest version so it has 41 columns! Within this, there are multiple variants of what is where, so chaos now reigns.

As a simple (maybe!) solution, I thought of the following workround.

To the right of the existing header row (which is in let's say A1 to T1)I copy the 41 column header row from the latest version and paste it in V1 to BJ1. Whatever the contents of the original column headers, they will be somewhere in the new header row.

What I now need is some sort of Index / Match or Offset / Match formula (if such a thing exists) to place beneath each of the headers in the new version which basically says 'look at the range of headers A1 to T1 and if there is matching text, put it here.' So for example if the original header text is in D1 and the matching header is in AN1, the contents of AN2 would equal D2.

It is then simply a matter of copying each of the new tables onto a combined master list.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
VBA Code - Transfer data to worksheet based on user entered list
Replies
0
Views
186
senior chow
S
G
  • Question
Help with writing VBA for data entry form
Replies
2
Views
792
GA036872
G
D
  • Question
Combing rows to retain latest only the latest data in each column
2
Replies
10
Views
1K
DarkV
D
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
392
AndyEd
A
K
  • Question
Comparing two sheets
Replies
3
Views
857
Killragtshirts
K

Forum statistics

Threads
1,214,830
Messages
6,121,835
Members
449,051
Latest member
excelquestion515

Share this page

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