Run a macro reading sheet names from an XLS file - excel

I'd like to run a macro that's reading all sheet names from an XLS file, and then being able to run the macro from the Run Command.
How is it possible?
For the moment I have the following code but I'd like to generalise it to other files (basically inputting the filename as a parameter in this macro and command).
Sub FnGetSheetsName()
Dim mainworkBook As Workbook
Set mainworkBook = ActiveWorkbook
For i = 1 To mainworkBook.Sheets.Count
'Either we can put all names in an array , here we are printing all the names in Sheet 2
mainworkBook.Sheets("Sheet2").Range("A" & i) = mainworkBook.Sheets(i).Name
Next i
End Sub

Create a macro enabled workbook.
Use one of the cell in Sheet1 to specify the path to excel file whose sheet names you want.
In Sheet1, insert an Active X Control button using developer mode.
In the code behind of the button (double click on the button keeping design mode enabled in developer tab -> VBA window opens), add following VB code and save it:
Private Sub CommandButton1_Click()
Dim sheetCount As Integer
Dim mainWorkBook, workbook1 As Workbook
Set mainWorkBook = ActiveWorkbook
Set workbook1 = Workbooks.Open(Range("A2"))
'Clear the contents of sheet 2, starting from row 2 - verify the last cell in sheet
Selection = mainWorkBook.Sheets("Sheet2").Range("A2:ZZ104857").ClearContents
If mainWorkBook.Sheets("Sheet1").Range("A2") = "" Then
MsgBox ("Enter Excel path")
GoTo exit1
End If
For sheetCount = 1 To workbook1.Sheets.Count
'Put sheet names of excel file in sheet 2 of macro book - you can find sheet names in Sheet2 starting from A2 cell.
mainWorkBook.Sheets("Sheet2").Range("A" & sheetCount + 1).Value = workbook1.Sheets(sheetCount).Name
Next sheetCount
exit1:
workbook1.Close (False)
End Sub
In the Sheet1 (of macro workbook), enter the excel path (whose sheetnames you want) in cell A2.
Click the Active X button (keeping design mode disabled).
You can find the result in Sheet2 of the macro workbook (Add suitable column names in first row of Sheet1 and Sheet2 of macro workbook for readability, if needed).

Related

VBA - Copy Sheets to new workbook without original workbook reference

I have a routine that is copying selected sheets from a "master" template workbook (containing all the templates for my customers) and pasting the selected sheets for a specific customer template into a new workbook (which the routine also generates).
The code works and importantly copies over formula's that pull text/data/values from a customer specific "DATA LOG SHEET" (which is always the first sheet amongst the selected sheets copied) across and into all the other selected sheets that are copied over into a new workbook.
However, it also copies over the reference to the original sheets in the "master", for example:
='[MasterTemplate.xlsm]DATA LOG SHEET (CUSTOMER NAME)'!B10)
The worksheets I'm copying need to be copied in the exact same formatting, here's routine I have currently:
Sub ArrayCustomerDocPackTemplateGenerator()
Dim myArray() As String
Dim myRange As Range
Dim Cell As Range
Dim OldBook As String
Dim newBook As String
Dim a As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Set myRange = Sheets("Sheet1").Range("B4:B11")
'Or the range with your sheetnames
OldBook = ActiveWorkbook.Name
For Each Cell In myRange
If Not Cell = "" Then
a = a + 1
ReDim Preserve myArray(1 To a)
myArray(a) = Cell
End If
Next
For a = 1 To UBound(myArray)
If a = 1 Then
Sheets(myArray(a)).Copy
newBook = ActiveWorkbook.Name
Workbooks(OldBook).Activate
Else
Sheets(myArray(a)).Copy After:=Workbooks(newBook).Sheets(a - 1)
Workbooks(OldBook).Activate
End If
Next
MsgBox "New Customer Doc Pack generated!", vbOKOnly
End Sub
I've created multiple copies of this routine tied to buttons for each customer. The only real difference in each version of the routine is the range of cells (listing the specific customer sheet names) that the routine pulls from.
My question is, is there a way to copy a selection of sheets with all of their formatting and internal formulas to a new workbook every time without copying the cell workbook reference of the "Master" Template?
Also, does my routine need to generate and/or name a new workbook first and then copy the sheets from the "Master" template over to work?
If so, how do I do that?

Macro to pull data from unnamed worksheets

Thank you in advance for the help with this question. I have a set of workbooks who have varying numbers of worksheets. On each worksheet, there are 6 cells of information that I need to have compiled onto one master worksheet in that workbook. The 6 cells of information are on the same page of every worksheet. My final output would be a table on one worksheet that has all of the data from the other worksheets in that book. I can do it manually but was hoping that a macro would help. I've tried using the activeworkbook.worksheet identifier but am stuck. Thanks for any help.
I was going to suggest the same thing #TheEngineer did because your question sounded too general and the only answer seemed to be for someone to code a complete solution for you.
However, reading a little closer, I think what you are asking for is the loop I've given you below.
Sub Macro1()
'
' Macro1 Macro
'
'
' 6 "working variables" to temporarily hold the values from each worksheet
Dim sCell1 as String
Dim sCell2 as String
Dim sCell3 as String
Dim sCell4 as String
Dim sCell5 as String
Dim sCell6 as String
Dim iTargetRowIdx as Integer 'counter to point at next empty row in target sheet
iTargetRowIdx = 1 'NOTE: change this if your 1st target row is not 1
For Each Sheet In ActiveWorkbook.Sheets
'avoid copying from the target worksheet itself
If Sheet.Name <> "<your target sheet name>" Then
'copy value from each of 6 cells to our working variables
'INSTRUCTION: replace each pair of "<row>" and "<col>" with row and column numbers of each of your 6 cells
sCell1 = Sheet.Cells(<row>, <col>) ' 1st cell to copy
sCell2 = Sheet.Cells(<row>, <col>) ' 2nd cell to copy
sCell3 = Sheet.Cells(<row>, <col>) ' 3rd cell to copy
sCell4 = Sheet.Cells(<row>, <col>) ' 4th cell to copy
sCell5 = Sheet.Cells(<row>, <col>) ' 5th cell to copy
sCell6 = Sheet.Cells(<row>, <col>) ' 6th cell to copy
'NOTE: if you want to see the value of what's in a cell while the macro is running, you can use Debug.Print, which prints to your Immediate Window (the little panel) at the bottom of the VBA editor) e.g.
Debug.Print (Sheet.Cells(1, 1))
'this prints what is in cell A1
'NOTE: Debug.Print is just a debugging tool to help you see what is going on inside your macro - you can safely remove the statement altogether
End If
'then put code here to paste those values to the next row in your target worksheet
'assumes you want the 6 values pasted to cols A to F in each new row
Worksheets("<your target sheet name").Cells(iTargetRowIdx, 1) = sCell1
Worksheets("<your target sheet name").Cells(iTargetRowIdx, 2) = sCell2
Worksheets("<your target sheet name").Cells(iTargetRowIdx, 3) = sCell3
Worksheets("<your target sheet name").Cells(iTargetRowIdx, 4) = sCell4
Worksheets("<your target sheet name").Cells(iTargetRowIdx, 5) = sCell5
Worksheets("<your target sheet name").Cells(iTargetRowIdx, 6) = sCell6
iTargetRowIdx = iTargetRowIdx + 1 'point to next empty row
Next Sheet
End Sub
This loops through every sheet in your workbook. Inside the loop, you do all the work you described. You need to edit the code for your specifics.
You didn't say if you want to run one macro for ALL workbooks or if just on one workbook. This macro runs for only one workbook and that is the workbook where you place this macro. You can put this macro in every workbook that you want it to work in OR you can post a separate question about how to run one macro on many workbooks.

Excel VBA code to search cells for a string, report the row, and replace row with provided material

I am a bit stuck and hoping some of you can help me. It's been about 5 years since I coded in C++, so I am a bit rusty and have never touched VBA before.
I am looking to batch replace a row of an excel workbook that contains a number (but might be text). In column B, there is a part number. The user should be able to put the part number in a field of the workbook containing the macro, as well as paste in the entire row (~30 columns worth of data) that needs to be inserted.
Example:
Part Number: 123456
Replaced with:
x 123457 Widget, Top 5 x 9 x 10 Plastic
The macro should run through all of the workbooks in a folder, search for the part number in column B (this part number is not always on the first sheet, sometimes it is on the second or third sheet) and replace the entire row with the row specified in the macro workbook. The row being copied and pasted will fit the destination formatting perfectly.
The workbook needs to be saved, closed, and the next operated on until all are complete.
I can iterate through the workbooks fine, but I am not sure how to search and return a specific row or how to copy paste the entire row from one workbook to another.
It would also be useful to record each file name that has been changed in the master workbook, but this is not a huge deal. I can grab it from a cell in the workbook.
I appreciate any help I can get, I am very lost with VBA.
-Sean
Edit: Here is my code:
Sub BatchReplace()
'For batch replacement of part number in ML's
'Edit with part to be replaced and with replacement row for ML
'Place subject MLs in "BATCH EDIT" folder.
'search for workbooks
'open first of x workbooks
'count sheets in workbook
'search for OldPN
'if found, return row of OldPN
'paste New Part in row
'continue search to B100
'search next sheet until sheet==sheetCount
'save
'
Dim strOldPN As String
Dim intRow As Integer
Dim rngNewPart As Range
Dim rngOldPN As Range
Dim wbMaster As Workbook, wbOp As Workbook
Dim i As Integer
Dim j As Integer
Set wbMaster = ThisWorkbook
Let strOldPN = wbMaster.Sheets("Sheet1").Cells(3, "E").Value 'Old part to search for
Set rngNewPart = wbMaster.Sheets("Sheet1").Range("A8,AE8") 'Copies new part row to replace
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Part Number to replace is " & strOldPN 'Display part number to be replaced
With Application.FileSearch
.NewSearch
.LookIn = "C:\ExcelBatchReplace\BATCHEDIT\" 'put files in this folder to change
.SearchSubFolders = True
.Filename = ".xls" 'all files ending in xls
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found." 'Displays number of documents in folder
Dim i As Integer
For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i), 0
'Do
'activeWorkbook, sheet1
'search Column B8:B100 for strOldPN
'intRow = Application.WorksheetFunction.Match(strOldPN, Range("B1:B100"), 0) 'Will this work?
'if found
'replace row with rngNewPart
'Continue search through B100
'else
'Sheet++
'While Sheet <= 4
ActiveWorkbook.Save
ActiveWorkbook.Close
Next i
Else
MsgBox "There were no files found."
End If
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
My psuedocode is where I am stuck. I've tried a few different methods but can't really get it to do what I want (or anything).
I would like to avoid the pitfalls of Active Workbook and refer to them as wbMaster (where the macro is located) and wbOp (where I am operating) but I couldn't get the later part to cooperate.
You can use the Range.Find and the Application.Save method to achieve this. The MSDN Developer Reference for Excel will be helpful for you.

Excel: Open in the first empty cell

Is it possible to let Excel automatically select the first empty cell in column A, whenever I open the document?
I have got the following to find the the first empty line:
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Value + 1.Count, 1).End(xlUp).Value + 1
In order to get Excel to select the first empty cell in column A when you open your workbook, you need to place the following code in the ThisWorkbook module.
Private Sub Workbook_Open()
Dim ws As Worksheet
Set ws = ActiveSheet
ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
End Sub
This will select the first empty cell in the ActiveSheet. If you got multiple sheets in your workbook and you want to select the first empty row in a specific sheet, say Sheet1, you should change the second line of code to:
Set ws = ActiveWorkbook.Sheets("Sheet1")
You can do that.
You need write VBA(macro) program to realize.
Code you need is as follow
Private Sub Workbook_Open()
ActiveWindow.Range("A65536").End(xlUp).Offset(1,0).Select
End Sub
Meaning of code is:
"Private Sub Workbook_Open()" is predefined name subroutine which will be executed when the workbook be opened.
"ActiveWindow.Range("A65536").End(xlUp)" will find last cell with data in A column ("last cell")
"ActiveWindow.Range("A65536").End(xlUp).Offset(1,0)" will move to cell next to "last cell", that will be first blank cell.
ActiveWindow.Range("A65536").End(xlUp).Offset(1,0).Select will select tha first blank cell.
I assumed that you use Excel 2003 or older, OR number of rows with data in your worksheet is less than 65536.
If you use Excel 2007 or newer and you have rows with data in your worksheet more than 65536, please modify 65536 to the value large enough to cover rows in your worksheet.

How to combine worksheets from more than 2 files into one worksheet in 1 file?

I have, say, 3 excel files, each contains 1 worksheet, those 3 worksheets have identical column header names.
File A has a worksheet named "AA" with column header names "IC", "Name".
File B has a worksheet named "BB" with column header names "IC", "Name".
File C has a worksheet named "CC" with column header names "IC", "Name".
.
.
.
Now I'd like to combine those the values under "IC", "Name" in worksheet "AA", "BB", and "CC" from File A, B, C into one worksheet in a file.
File ZZ has worksheet named "zz" with column header names "IC", "Name" that have all rows values from File A, B, and C...
Could anyone share how to do it ?
Thank you :)
Can you not simply use copy and paste? Copy contents of file A into an empty workbook, file Z. Then copy all of the data rows in file B (excluding the headers) and paste below the existing data in file Z. Repeat for file C.
Without knowing what conventions your workbooks (you call them files) use, I've created a macro that does as you ask but makes some assumptions. This does exactly as you ask, but it might need some alterations based on your files.
Assumptions:
All workbook header rows IC and Name are located in cells A1 and B1, respectively
All workbooks will be open before running this macro
The macro will be initiated from the Parent Workbook, which is assumed to be the WorkBook that will house the final result
All values for each workbook are in the first sheet of that workbook
Code
Public Sub CombineAllOpenWorkbooks()
Dim parentWb As Workbook, childWb As Workbook
Dim destinationWs As Worksheet, sourceWs As Worksheet
Dim highestRowCount As Integer
Dim firstColumnRowCount As Integer
Dim secondColumnRowCount As Integer
Application.ScreenUpdating = False
'this holds reference to the parent workbook, which is where all the values go
Set parentWb = Application.Workbooks(ThisWorkbook.Name)
Set destinationWs = parentWb.Sheets(1)
'for each workbook open that isn't the aprent workbook, find the last cell,
'select it, copy its values, then paste them at the end of the parent workbooks
'current values
For Each childWb In Application.Workbooks
If childWb.Name <> parentWb.Name Then
Set sourceWs = childWb.Sheets(1)
firstColumnRowCount = sourceWs.Cells(Rows.Count, 1).End(xlUp).Row
secondColumnRowCount = sourceWs.Cells(Rows.Count, 2).End(xlUp).Row
highestRowCount = firstColumnRowCount
If firstColumnRowCount < secondColumnRowCount Then
highestRowCount = secondColumnRowCount
End If
'copy from below the 'IC/Name' headers to the last cell that contains values
sourceWs.Range(sourceWs.Cells(2, 1), sourceWs.Cells(highestRowCount, 2)).Copy
firstColumnRowCount = destinationWs.Cells(Rows.Count, 1).End(xlUp).Row
secondColumnRowCount = destinationWs.Cells(Rows.Count, 2).End(xlUp).Row
highestRowCount = firstColumnRowCount
If firstColumnRowCount < secondColumnRowCount Then
highestRowCount = secondColumnRowCount
End If
'paste the previously copied values to the end of the parent workbokos values
destinationWs.Range("A" & highestRowCount + 1).PasteSpecial Paste:=xlPasteValues
End If
Next childWb
Application.ScreenUpdating = True
End Sub
To add this VBA to your workbook, you must Open the Developer Tab of the PARENT Workbook, choose Visual Basic from the menu, open Sheet 1 from the left menu, then paste the code there.
Here are some images of the workbooks I used during testing (ParentWorkbook, FileA, FileB):
All three workbooks BEFORE running macro:
Parent workbook AFTER running macro:
Please note that this code was created quickly and limited testing has been done. It can certainly be cleaned up and redundancy within the code can be removed; it's purpose is to get you started. If you have any questions about any part I'd be happy to explain.
I tried this software and it worked: http://bulkfilemerger.com/index1

Resources