Disclaimer - I used to write macros a lot, but it's a perishable skill. 5 years takes it toll.
The basic concept is this:
I have a template workbook, with up to 30 tabs, that all have indeterminate rows and columns (i.e. It's not always A7:J30 - one tab might have 3 columns, the next 34 columns. Rows are also indeterminate.).
Currently, someone is copy/pasting 30 separate CSVs into this one templated workbook.
This templated workbook is read by another program to populate data. Row 6 of each template sheet is where the other program looks for headers (i.e. I might copy a CSV's data from A2:G1000, but it would need to paste in A7:G1005 of the template target workbook).
All of the CSVs are stored in the same directory. We can copy/paste a Template workbook into that directory, run a macro, and be done.
What I've done so far:
Sub V1BruteForceCopy()
'
'This code lives in ImportTemplate.XLSM, and is run from the same
'
Workbooks.Open (ThisWorkbook.Path & "\deposits.csv") 'Open deposits.CSV in same directory
Range("A2:G1000000").Copy 'Very inflexible copy job - ugly.
Windows("ImportTemplate.xlsm").Activate 'hate to Activate, but can't get it to work without it.
Sheets("depositbatches").Range("A7").Select 'must call each Sheet in the code, instead of declare variable
ActiveSheet.Paste 'don't like Activate, but Sheets("depositbatches").Range("A7").Paste throws an error.
End Sub 'to add a new CSV and a new Sheet to copy to, I have to copy a whole new block of code and then overwrite Sheets("name") and Workbooks.Open(ThisWorkook.Path & "\name.csv") every time.
Other things I've tried:
Sub rangecopy_001()
Dim ImpTemp As Workbook 'Reserved for ImportTemplate
Dim CSVdeposits As Workbook 'Reserved for deposits.CSV
Dim shDeposits As Worksheet 'Deposits worksheet inside ImportTemplate
Dim lRow As Long 'variable for last row
Dim lCol As Long 'variable for last column
Dim test As Range 'variable for copy/paste range
Set ImpTemp = Workbooks.Open(ThisWorkbook.Path & "\ImportTemplate_CSV.xlsm") 'Open DWImportTemplate
Set CSVdeposits = Workbooks.Open(ThisWorkbook.Path & "\deposits.csv") 'Open deposits.CSV
Set shDeposits = ImpTemp.Sheets("depositbatches") 'Declare that shDeposits is a ImportTemplate sheet
With CSVdeposits 'copy out of deposits.CSV and paste into ImportTemplate deposits sheet
'find last row - makes this dynamic
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'find last column - makes this dynamic
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
test = CSVdeposits.Sheet(1).Range("A2:" & Cells(lRow, lCol)) 'error code 438 - Object doesn't support method
DW.shDeposits.Range("A7") = test
End With
End Sub
This makes the copy range dynamic, but I'm still getting an object error when I try to select the range. I got this method from (Copy from one workbook and paste into another) but it's too simple. Plus, if I want to add another 20 tabs, I have to copy/paste this code block another 20 times and change the variables each time.
I found this (Copy multiple rows from multiple workbooks to one master workbook), but Ron DeBruin's thing won't work because we have to move everything down to Row 6, plus we can't count on the headers of the CSVs working properly.
I like the last answer here (Dynamic range of data to paste into another sheet?) but I can't seem to make it work for a single workbook target from other workbooks.
I want to use an array, or set of arrays to declare my worksheets, but I don't know how to iterate over two arrays at one time that are string-based. I'm thinking something like this, but I'm not done:
Sub ArrayCopyV1()
'
'This code lives in Template.XLSM and is run from the same. Copy this book to the directory you wish to copy from.
'
'
Dim ArraySheets As Variant 'an array with all Sheet names. Should have the same number of args as ArrayCSVs array.
Dim ArrayCSVs As Variant 'an array with all CSV names Should have the same number of args as ArraySheets array.
Dim template As Worksheet 'variable for template worksheet inside
Template workbook
Dim CSV As Workbook 'variable for CSV workbook
Dim i As Integer 'variable i to be used in FOR loop counter
Dim lcol as Integer
Dim lrow as Integer
ArraySheets = Array("depositbatches", "otherSheet1", "OtherSheet2")
ArrayCSVs = Array("\deposits.csv", "other1.csv", "Other2.csv")
For i = LBound(ArraySheets) To UBound(ArraySheets)
Set CSV = Workbooks.Open(ThisWorkbook.Path & ArrayCSVs(i))
Set template = Workbooks.Open(ThisWorkbook.Path & ArraySheets(i))
With CSV 'copy out of deposits.CSV and paste into DWImportTemplate deposits sheet
'find last row - makes this dynamic
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'find last column - makes this dynamic
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
test = CSV.Sheet(1).Range("A2:" & Cells(lRow, lCol))
template.Range("A7") = test
End With
Next i
End Sub
For example:
Sub CopyAll()
Dim rw As Range, wb As Workbook
'read over your file<>sheet table
For Each rw In ThisWorkbook.Sheets("Files").Range("A2:B30").Rows
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & rw.Cells(1).Value) '<< csv file name
With wb.Sheets(1).Range("A1").CurrentRegion
'skip headers (relies on contiguous data)
.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Copy _
ThisWorkbook.Sheets(rw.Cells(2).Value).Range("A7") '<< sheet name to paste into
End With
wb.Close False
Next rw
End Sub
Related
Good day, I am a newbie to VBA. I have not included the code I have tried, because nothing has even come close.
I have a Data range of about 10,000 that contains the building, department, user name and possibly other information. This information is in column B. The names are not in the same location of each cell and they can be any case and can contain up to 4 words.
I have a Named Range (Full Name) of about 14,000 names in a separate workbook named database.
I need to see if the names show up in the data range list and if so populate column C with the name.
Thanks in advance for any assistance.
Example code:
Sub Full_Name()
Dim iWs As Worksheet, iFn As Variant, lastrow As Long, iDB As Worksheet
iFn = Range("'[Shadow Datafie Database.xlsx]EMCP'!Full_Name").Value
Set iWs = ActiveWorkbook.Worksheets("EMCP")
lastrow = iWs.UsedRange.Rows.Count + 1
For i = 2 To lastrow
If InStr(iWs.Cells(i, 2), iFn) > 0 Then
iWs.Cells(i, 3) = iFn
End If
Next
End Sub
This code may work for you:
It assumes your list of names is in an Excel table called Table1.
Sub FindName()
'Open the csv file containing your information - building, department, etc.
Dim wrkBkSrc As Workbook
Set wrkBkSrc = Workbooks.Open("<path to your file>\Numplan(11).csv")
'A csv file will only contain a single sheet, so can reference it by sheet position - first and only.
With wrkBkSrc.Worksheets(1)
Dim DataRange As Range
Set DataRange = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
' *** OLD CODE ***
' With ThisWorkbook.Worksheets("Sheet1")
' Dim DataRange As Range
' Set DataRange = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
' End With
'Open the database file and set reference to it.
Dim wrkBk As Workbook
Set wrkBk = Workbooks.Open("<path to your file>\Database.xlsx")
'Set reference to the names table.
'Note: This is an Excel table, not an Excel range.
' Press Ctrl+T to turn range into a table.
Dim NameTable As ListObject
Set NameTable = wrkBk.Worksheets("Database").ListObjects("Table1")
'Only continue if there's data in the table.
If Not NameTable.DataBodyRange Is Nothing Then
Dim NameItm As Range
Dim FoundItm As Range
For Each NameItm In NameTable.DataBodyRange
'Find the name within the DataRange.
Set FoundItm = DataRange.Find( _
What:=NameItm, _
After:=DataRange.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'If it's found place the name in the next column along.
If Not FoundItm Is Nothing Then
FoundItm.Offset(, 1) = NameItm
End If
Next NameItm
End If
End Sub
I'm trying to create a single PDF file containing a sheet for each tab which I have listed from cell J2 in my Control sheet but I keep getting a Subscript Out Of Range error.
When I record the action I see that it creates an array of sheet names which it then selects to export, so I have a For loop which goes through the list and creates an array which adds to itself until it reaches the end of the list - the aim being to create one long string which I then select as an array.
All appears to be good (the variable PDFArray displays a string of the tab names in what appears to be the correct format) but when I get to the line 'Worksheets(Array(PDFarray)).Select' then I get the error. I've made sure the sheet names contain no undesirable characters or spaces but still no joy. Any help would be very much appreciated. Thank you
Sub B_PDFs()
Dim PDFarray As String, PDFName as String, sht As String
Sheets("Control").Select
PLFile = ActiveWorkbook.Name
PDFLoc = Application.ActiveWorkbook.Path & "\"
PDFName = Range("A20")
PDFSheetCount = Range("J1").Offset(Rows.Count - 1, 0).End(xlUp).Row
'Loop through column J and create a string with each tab name to be exported
For x = 2 To PDFSheetCount Step 1
If x = PDFSheetCount Then
sht = """ " & "" & Cells(x, 10) & """ "
Else
sht = """" & "" & Cells(x, 10) & """" & ", "
End If
PDFarray = PDFarray & sht
Next x
'Create PDF from the array above
Worksheets(Array(PDFarray)).Select - this is where I get the error Subscript Out Of Range
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PFDLoc & PDFName, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False,
OpenAfterPublish:=False
Workbooks(PLFile).Activate
End Sub
I don't understand why MS makes NOT requiring variable declaration the default. Select Tools/Options/Editor and check Require Variable Declaration. This will place Option Explicit at the start of any new module. To correct this module, enter it manually at the beginning.
Doing so would have enabled you to find and correct a typo in your code.
You should also be avoiding Select, Selection and Activate. They rarely serve any purpose at all, and can cause multiple problems because they lull into avoiding explicit declarations of which workbook, worksheet, etc. you need. See How to avoid using Select in Excel VBA
However in using the ExportAsFixedFormat method to export selected worksheets, it seems Selection and ActiveSheet are required for it to work.
Array(str_variable) returns an array with a single entry that contains the entire string variable. It does not interpret the string variable so as to split it into separate elements.
So, rewriting your code somewhat (I will leave it to you to clean up the PDF document):
Option Explicit
Sub B_PDFs()
Dim PDFarray As Variant, PDFName As String, PLFile As String, PDFLoc As String
Dim wsControl As Worksheet
Dim WB As Workbook
'Consider wheter you want to use ThisWorkbook or a specific workbook
Set WB = ThisWorkbook
With WB
Set wsControl = .Worksheets("Control")
PLFile = .Name
PDFLoc = .Path & "\"
End With
With wsControl
PDFName = .Range("A20")
'create PDFarray
'This will be a 1-based 2D array starting at J1
'If you need to start at J2, alter the initial cell
PDFarray = .Range(.Cells(1, 10), .Cells(.Rows.Count, 10).End(xlUp))
End With
'convert to a 1D array
PDFarray = WorksheetFunction.Transpose(PDFarray)
'Note the use of `Select` and `ActiveSheet` when using this `ExportAsFixedFormat` method
Worksheets(PDFarray).Select
'Create PDF from the array above
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFLoc & PDFName, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
What #RonRosenfeld has suggested is correct about select and selection. The expression you are building is string whereas, Excel expects it to be real array.
So in principle an approach like below shall work for you which will create an array for processing and can be used as you want to utilise.
Dim shtNames As Variant
Dim pdfArray
shtNames = Range("J2:J" & Range("J1").Offset(Rows.Count - 1, 0).End(xlUp).Row).Value
pdfArray = Application.Transpose(shtNames)
I have a dirty database where the names of each individual are written in different ways and I cannot group them.
I would like to create a macro to find and replace the names in the database using a two column list.
I have found the following code, but I´m having trouble understanding it, so cannot adapt it:
Dim Sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant
Dim Rng As Range
'Create variable to point to your table
Set tbl = Worksheets("How to").ListObjects("Table2")
'Create an Array out of the Table's Data
Set TempArray = tbl.DataBodyRange
myArray = Application.Transpose(TempArray)
'Designate Columns for Find/Replace data
fndList = 1
rplcList = 2
'Loop through each item in Array lists
For x = LBound(myArray, 1) To UBound(myArray, 2)
'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
For Each Rng In Worksheets("xxxxxxxxxx").Activate
If Rng.Name <> tbl.Parent.Name Then
Rng.Cells.replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
End If
Next Rng
Next x
End Sub
I have adjusted your code which you can see below; couple notes:
1- Using Option Explicit is always a good idea
2- If you put the array loop inside the sheet loop, you only have to perform the sheet name check n times (n=number of sheets in workbook), if you put the sheet loop inside the array loop you would have to perform the sheet name check n*x times (x = number of items in your array)...
3- You didn't specify, but I assumed that your Table1 was structured vertically with the lookup value in the first column and the replacement value in the 2nd- so there is no need to transpose your array; if your Table1 is in fact horizontal then you would need to adjust this code...
Public Sub demoCode()
Dim sheetName As String
Dim tableRange As Range
Dim myArray() As Variant
Dim wsCounter As Long
Dim rowCounter As Long
'Store name of sheet with lookup table
sheetName = "How to"
'Create an Array out of the Table's Data
Set tableRange = ThisWorkbook.Sheets(sheetName).ListObjects("Table1").DataBodyRange
myArray = tableRange
'Loop through each sheet
For wsCounter = 1 To ThisWorkbook.Sheets.Count
With ThisWorkbook.Sheets(wsCounter)
'Test to make sure the sheet is not the sheet with the lookup table
If .Name <> sheetName Then
'Loop through each item in lookup table
For rowCounter = LBound(myArray, 1) To UBound(myArray, 1)
'Replace any cells that contain whats in the first column of the lookup table, with whats in the 2nd column..
.Cells.Replace What:=myArray(rowCounter, 1), Replacement:=myArray(rowCounter, 2), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
End If
End With
Next
End Sub
Hope this helps,
TheSilkCode
so to answer your second question, basically what you would need to do is remove the sheet loop (which you have done), and then the part you're missing is you also need to specify you want the code to perform the replace on just the cells within the target range, instead of performing it on the cells within the sheet (which would be all the cells)... see below for example:
Public Sub demoCode_v2()
Dim tableRange As Range
Dim myArray() As Variant
Dim rowCounter As Long
Dim targetRange As Range
'Create an Array out of the Table's Data
Set tableRange = ThisWorkbook.Sheets(sheetName).ListObjects("Table1").DataBodyRange
myArray = tableRange
'Select target range
Set targetRange = Application.InputBox("Select target range:", Type:=8)
'Loop through each item in lookup table
For rowCounter = LBound(myArray, 1) To UBound(myArray, 1)
'Replace any cells in target range that contain whats in the first column of the lookup table, with whats in the 2nd column..
targetRange.Cells.Replace What:=myArray(rowCounter, 1), Replacement:=myArray(rowCounter, 2), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
End Sub
Hope this helps,
TheSilkCode
Using a slight adjustment of TheSilkCode code you could loop through a worksheet as follows:
Option Explicit
Public Sub pDemo()
Dim vMappingTable() As Variant
Dim rowCounter As Long
'1) Create an Array out of the Old to New Name mapping
vMappingTable = wksMappings.ListObjects("tbl_Mapping").DataBodyRange
'2) Loops through desired sheet and replaces any cells that contain the first column val, with the 2nd column val...
With wksToReplace.Range("X:X")
For rowCounter = LBound(vMappingTable, 1) To UBound(vMappingTable, 1)
.Cells.Replace What:=vMappingTable(rowCounter, 1), Replacement:=vMappingTable(rowCounter, 2), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
End With
End Sub
Note: you can define names of table via the Name manager (Ctrl+F3) and you can set the name of worksheets in your project in the properties in the VBA editor which I have done here or use the default names/and or path.
I want to select a array of sheets using the Sheets(Array()) method.
The sheets I want to select are named in the cells of my workheet Printlist.
The sheetnames are listed form column D to K.
Not all cells are filled so if I use the folowing function it errors on the rows with blank cells. How can I avoid this error:
This is what the sheet looks like:
And this is the code
Sub PDF_maken()
Dim ws As Worksheet
Dim LR As Long
Dim r As Range
Dim Mypath As String
Dim strarray As String
Set ws = ActiveWorkbook.Worksheets("Printlijst")
LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
For Each r In ws.Range("B20:B20").Cells
If Not IsEmpty("B" & r.Row) Then
Mypath = ws.Range("B" & r.Row).Text
colCheck = 4
Do Until Cells(r.Row, colCheck) = ""
strarray = strarray & IIf(colCheck > 4, ",") & """" & Cells(r.Row, colCheck).Value & """"
colCheck = colCheck + 1
Loop
ActiveWorkbook.Sheets(strarray).Select
ActiveWorkbook.SelectedSheets.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Mypath & ws.Range("C" & r.Row).Text & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
Next r
End Sub
You can use a regular array rather than the Array() function to create the array. Then you can loop through the cells that contains sheet names and only add them if they're not blank. Here's an example.
Sub PDF_maken()
Dim ws As Worksheet
Dim lLastRow As Long
Dim rMap As Range
Dim sPath As String
Dim aSheets() As String
Dim lShCnt As Long
Dim rSh As Range
Set ws = ActiveWorkbook.Worksheets("Printlist")
lLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For Each rMap In ws.Range("B2:B" & lLastRow).Cells
'Make sure there's a path
If Not IsEmpty(rMap.Value) Then
sPath = ws.Range("B" & rMap.Row).Text
're-dimension an array to hold all the sheet names
ReDim aSheets(1 To Application.WorksheetFunction.CountA(rMap.Offset(, 2).Resize(1, 8)))
'reset the counter
lShCnt = 0
'loop through all the cells that might have a sheet name
'and add them to the array
For Each rSh In rMap.Offset(, 2).Resize(1, 8).Cells
If Not IsEmpty(rSh.Value) Then
lShCnt = lShCnt + 1
aSheets(lShCnt) = rSh.Text
End If
Next rSh
ActiveWorkbook.Sheets(aSheets).Select
ActiveSheet.ExportAsFixedFormat xlTypePDF, sPath & rMap.Offset(0, 1).Text & ".pdf"
End If
Next rMap
ws.Select
End Sub
If you get Error 9: Subscript Out of Range there are three things to check:
The first one is that you spelled a sheet name wrong. Make sure there are no spaces or other funny business that makes it look like you have a good sheet name and you don't.
Next, make sure you qualify all of your references back to the workbook level. Depending on where your code is, unqualified references can point to different places. Don't ever use Sheets(). Always use ThisWorkbook.Sheets() or some other workbook reference. That will make sure you're not trying to access a sheet in a workbook that you didn't intend to.
Finally, you can get that error if you pass numbers to Sheets because your sheet names are numbers. Or rather they look like numbers, but they're really text. sheets(array(1234,4567)).select is different than sheets(array("1234","4567")).select. You have to pass strings to Sheets or you'll get that error. Kind of. You can pass numbers, but it will Select the sheets based on their index numbers rather than their names. That's why you have to be extra careful when your sheet names look like numbers.
Do a similar loop,
something like
colCheck=4
do until cells(r.row,colCheck)=""
strArray=strarray & iif(colCheck>4,",","") & cells(r.row,colCheck).value
colCheck=colCheck+1
loop
then you'll get something like a,b,c I've not tested this, so may need some tweaking. I'll revisit in a moment.
The goal of my macro is from a large set of data, divide the data into separate workbooks for each product. After I paste only the specific data into the file, I want to copy 5 separate worksheets from the workbook with all of the data, each worksheet with a pivot table on them, set the data on the pivot table to the data on the spread sheet that I copied over previously. Then refresh the pivot tables.
My biggest question is how to I name an array of worksheets to a work book
Dim cell As Range, DataRng As Range
Dim curPath As String, curWB As String, newWB
Dim ArrayCM As Variant
Dim InxW As Long
Dim xTable As PivotTable
curPath = ActiveWorkbook.Path & "\"
curWB = ActiveWorkbook.Name
'Array of worksheets to be copied over for Company Manger
Set ArrayCM = curWB.Sheets(Array("CM YTD", "CM MTD", "CM Refurb", "TBM Local", "PSM"))
--This Gives me an error
Because I'm going to creating several workbooks, I want to define my array to copy over from the master file to the new file. Help on this would be greatly appreciated.
You can create a worksheet type var as an array, redim it and assign each element within the array to a Worksheet Object.
Sub manyWSs()
Dim w As Long
Dim cwb As Workbook
Dim wss() As Worksheet
Set cwb = ThisWorkbook
With cwb.Worksheets(Array("Sheet1", "Sheet3", "Sheet5"))
ReDim wss(1 To .Count)
For w = 1 To .Count
Debug.Print .Item(w).Name
Set wss(w) = .Item(w)
Next w
End With
For w = LBound(wss) To UBound(wss)
Debug.Print wss(w).Cells(1, 1).Address(0, 0, external:=True)
Next w
End Sub
The Worksheets(Array("Sheet1", "Sheet3", "Sheet5")) is not a true Worksheets collection so .Item(w) is used to pick out the pieces. Once each piece has been Set, all the properties, methods and members of a single Worksheet Object are available to each piece of the array with full parent Workbook object association.