Atrax27 Posted December 7, 2020 Share Posted December 7, 2020 Splitting out data within a single workbook is relatively simple in VBA, but I'm going to start looking into autoIT for my solutions as it involves multiple .xlsx files. The below code is brought to you by none other than the famous @water dug up from an old thread. #include <Excel.au3> #include <File.au3> Global $aWorkbooks[] = ["C:\Users\exceltest\Book1.xlsx", "C:\Users\exceltest\Book2.xlsx", _ "C:\Users\exceltest\Book3.xlsx", "C:\Users\exceltest\Book4.xlsx"] Global $sDrive, $sDir, $sFileName, $sExtension $oExcel = _Excel_Open() $oWorkbookOut = _Excel_BookNew($oExcel, 1) For $i = 0 To UBound($aWorkbooks, 1) - 1 $oWorkbookIn = _Excel_BookOpen($oExcel, $aWorkbooks[$i], True) $oSheet = _Excel_SheetCopyMove($oWorkbookIn, 1, $oWorkbookOut, $i + 1) _Pathsplit($aWorkbooks[$i], $sDrive, $sDir, $sFileName, $sExtension) $oSheet.Name = $sFileName _Excel_BookClose($oWorkbookIn) Next This is very useful combining multiple files into a single workbook with multiple tabs (one tab per file). But what if you wanted all those resulting tabs to be combined into one "master" tab? VBA code below Sub CopyFromWorksheets() Dim wrk As Workbook 'Workbook object - Always good to work with object variables Dim sht As Worksheet 'Object for handling worksheets in loop Dim trg As Worksheet 'Master Worksheet Dim rng As Range 'Range object Dim colCount As Integer 'Column count in tables in the worksheets Set wrk = ActiveWorkbook 'Working in active workbook For Each sht In wrk.Worksheets If sht.Name = "Master" Then MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ "Please remove or rename this worksheet since 'Master' would be" & _ "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" Exit Sub End If Next sht 'We don't want screen updating Application.ScreenUpdating = False 'Add new worksheet as the last worksheet Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 'Rename the new worksheet trg.Name = "Master" 'Get column headers from the first worksheet 'Column count first Set sht = wrk.Worksheets(1) colCount = sht.Cells(1, 255).End(xlToLeft).Column 'Now retrieve headers, no copy&paste needed With trg.Cells(1, 1).Resize(1, colCount) .Value = sht.Cells(1, 1).Resize(1, colCount).Value 'Set font as bold .Font.Bold = True End With 'We can start loop For Each sht In wrk.Worksheets 'If worksheet in loop is the last one, stop execution (it is Master worksheet) If sht.Index = wrk.Worksheets.Count Then Exit For End If 'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 'Put data into the Master worksheet trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value Next sht 'Fit the columns in Master worksheet trg.Columns.AutoFit 'Screen updating should be activated Application.ScreenUpdating = True End Sub One problem with the VBA code above is that it ignores when columns are not aligned with eachother, such as: TAB 1 Column 1 Column 2 Column 3 Column 4 ff gg hh jj tt yy uu ii TAB 2 Column 3 Column 4 Column 1 Column 2 11 22 33 44 55 66 77 88 RESULTS Column 1 Column 2 Column 3 Column 4 ff gg hh jj tt yy uu ii 11 22 33 44 55 66 77 88 but what I'd like is: Column 1 Column 2 Column 3 Column 4 ff gg hh jj tt yy uu ii 33 44 11 22 77 88 55 66 I've read through the UDF and am getting closer to understanding it but have some difficulties with this one. Thanks. Link to comment Share on other sites More sharing options...
water Posted December 7, 2020 Share Posted December 7, 2020 (edited) I suggest to sort each tab on the columns so that tab2 has the same content as all other tabs before combining them into a single tab. An example can be found in the help file for _Excel_RangeSort (Example 3). Column 1 Column 2 Column 3 Column 4 33 44 11 22 77 88 55 66 Edited December 7, 2020 by water My UDFs and Tutorials: Spoiler UDFs: Active Directory (NEW 2024-07-28 - Version 1.6.3.0) - Download - General Help & Support - Example Scripts - Wiki ExcelChart (2017-07-21 - Version 0.4.0.1) - Download - General Help & Support - Example Scripts OutlookEX (2021-11-16 - Version 1.7.0.0) - Download - General Help & Support - Example Scripts - Wiki OutlookEX_GUI (2021-04-13 - Version 1.4.0.0) - Download Outlook Tools (2019-07-22 - Version 0.6.0.0) - Download - General Help & Support - Wiki PowerPoint (2021-08-31 - Version 1.5.0.0) - Download - General Help & Support - Example Scripts - Wiki Task Scheduler (2022-07-28 - Version 1.6.0.1) - Download - General Help & Support - Wiki Standard UDFs: Excel - Example Scripts - Wiki Word - Wiki Tutorials: ADO - Wiki WebDriver - Wiki Link to comment Share on other sites More sharing options...
GokAy Posted December 7, 2020 Share Posted December 7, 2020 @water Can you sort by something other than ascending/descending? What if column names do not conform to an order as in Atrax27's example? @Atrax27 If you can use VBA, why not use it? If I were you, I would - Create an xlsm file - Create 2 sheets in it and assign codenames through VBA Editor i.e, "Settings" and "Data" - Maybe create a button to start the macro? - Write the column headers in row 1 of Settings Column A (If I want the columns to be in any order I want other than what would be in one of those files). Would give you control on the sorting order as well. - Starting from row 3 of Settings Column A, write down the filenames with full path The macro logic would be: 1 - Clean Data sheet 2 - Read column sort order from Settings.range("A1").currentregion, write to Data as header 3 - Read filenames from Settings.range("A3").currentregion 4 - For each filename, open workbook 4 - 1 For each worksheet in workbook 4 - 2 Find currentregion of worksheet, get row count 4 - 3 For each Column Header - In the order of column sort order (Step 2) 4 - 3 - 1 Find out and Copy the corresponding column to Data sheet next available row Considerations: Do workbooks contain sheets other than the desired sheets? How would you want to distinguish the two if so? How are these workbooks formed? Humans involved? Any possible typos in column names? Is it possible there will be totally empty rows in the data to be copied? Link to comment Share on other sites More sharing options...
water Posted December 7, 2020 Share Posted December 7, 2020 (edited) The columns conform to an order: Column 1 Column 2 Column 3 Column 4 I just re-read your question. If you want to sort in a different order then just prefix the column headers with the requried sort order. Example: if you need "g h d a" sorted as "d h a g" then prefix the columns with an index number like "04g 02h 01d 03a", sort them and then remove the first 2 numbers from the column headers. Edited December 7, 2020 by water GokAy 1 My UDFs and Tutorials: Spoiler UDFs: Active Directory (NEW 2024-07-28 - Version 1.6.3.0) - Download - General Help & Support - Example Scripts - Wiki ExcelChart (2017-07-21 - Version 0.4.0.1) - Download - General Help & Support - Example Scripts OutlookEX (2021-11-16 - Version 1.7.0.0) - Download - General Help & Support - Example Scripts - Wiki OutlookEX_GUI (2021-04-13 - Version 1.4.0.0) - Download Outlook Tools (2019-07-22 - Version 0.6.0.0) - Download - General Help & Support - Wiki PowerPoint (2021-08-31 - Version 1.5.0.0) - Download - General Help & Support - Example Scripts - Wiki Task Scheduler (2022-07-28 - Version 1.6.0.1) - Download - General Help & Support - Wiki Standard UDFs: Excel - Example Scripts - Wiki Word - Wiki Tutorials: ADO - Wiki WebDriver - Wiki Link to comment Share on other sites More sharing options...
Atrax27 Posted December 8, 2020 Author Share Posted December 8, 2020 Since I dont actually care the order of columns, only that they are the same between tabs. Here is a good VBA that works well. Sub SortLTable() Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Sort Key1:=Range(Selection, Selection.End(xlDown)), Order1:=xlAscending, Orientation:=xlLeftToRight End Sub Kinda bummed that I don't yet understand AutoIT well enough yet, since theres likely a better/faster solution within a UDF somewhere, I'm just not proficient enough yet Link to comment Share on other sites More sharing options...
GokAy Posted December 8, 2020 Share Posted December 8, 2020 Get rid of the selects you don't need to select in most cases in Excel VBA. It will slow you down too depending on how much computation you are doing. ' All These Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select ' Can be achieved with (see what is being selected when you click cell A1 and press (CTRL + *)) Dim rRange as Range Set rRange = ActiveSheet.Range("A1").CurrentRegion ' Then play with .Offset(), and .Resize() for ranges you need ' i.e., rRange.resize(1,rRange.Columns.Count) ' All Column Headers Set rRange = Nothing ' When you are done with it. Not necessary in most cases, but good coding practice An example from the file I am working on atm: "Import" is the sheet codename. Don't mind all the variables. With Import.Sort .SortFields.Clear .SortFields.Add2 key:=Import.Range("M1").Offset(1, i - CalcColumn).resize(SectionEnd - SectionStart + 1, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Import.Range("M1").Offset(1, i - CalcColumn).resize(SectionEnd - SectionStart + 1, 1) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Atrax27 1 Link to comment Share on other sites More sharing options...
GokAy Posted December 8, 2020 Share Posted December 8, 2020 There are many channels, but I always thought this one is different somehow. Check out https://www.youtube.com/c/Excelmacromastery/videos if you are interested. Link to comment Share on other sites More sharing options...
Subz Posted December 8, 2020 Share Posted December 8, 2020 Couldn't you just read the tab to an array and then swap the columns based on the header row (maybe I'm missing something). #include <Array.au3> Local $aTab1[][] = [["Column 1","Column 2", "Column 3", "Column 4"],["ff","gg","hh","jj"],["tt","yy","uu","ii"]] Local $aTab2[][] = [["Column 3","Column 4","Column 1","Column 2"],["11","22","33","44"],["55","66","77","88"]] For $i = 0 To UBound($aTab2, 2) -1 If $aTab2[0][$i] = "Column 1" Then _ArraySwap($aTab2, $i, 0, True) If $aTab2[0][$i] = "Column 2" Then _ArraySwap($aTab2, $i, 1, True) If $aTab2[0][$i] = "Column 3" Then _ArraySwap($aTab2, $i, 2, True) If $aTab2[0][$i] = "Column 4" Then _ArraySwap($aTab2, $i, 3, True) Next _ArrayDisplay($aTab2) Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now