Using code from the spreadsheet guru to loop through files in a folder and perform a set task on them, seems to be working properly. Where I may have made a mistake is the set task portion of the code.
Using Excel 2010.
sourcewb = ActiveWookbook
sourcefn = ActiveWorkbook.Name
masterwb = ThisWorkbook
masterwb.Activate
lr = ActiveSheet.ListObjects("DataTbl").ListRows.Count
If ActiveSheet.ListObjects("DataTbl").DataBodyRange(lr, 1).Value = "" Then
sourcewb.Activate
ActiveSheet.ListObjects("IntermidateTbl").DataBodyRange.Copy
masterwb.Activate
ActiveSheet.ListObjects("DataTbl").DataBodyRange(lr, 1).Select
Selection.Paste
newlr = ActiveSheet.ListObjects("DataTbl").ListRows.Count
Range(ActiveSheet.ListObjects("DataTbl").DataBodyRange(lr, 8), _
ActiveSheet.ListObjects("DataTbl").DataBodyRange(newlr, 8)) = "" & sourcefn & ""
Else
ActiveSheet.ListObjects("DataTbl").ListRows.Add AlwaysInsert:=True
sourcewb.Activate
ActiveSheet.ListObjects("IntermidateTbl").DataBodyRange.Copy
masterwb.Activate
ActiveSheet.ListObjects("DataTbl").DataBodyRange(lr + 1, 1).Select
Selection.Paste
newlr = ActiveSheet.ListObjects("DataTbl").ListRows.Count
Range(ActiveSheet.ListObjects("DataTbl").DataBodyRange(lr + 1, 8), _
ActiveSheet.ListObjects("DataTbl").DataBodyRange(newlr, 8)) = "" & sourcefn & ""
End If
There are more than a few errors, I'll try to help with a few.
You are trying to set sourcewb, which is a Workbook object, so you need to change:
sourcewb = ActiveWookbook
To:
Set sourcewb = ActiveWookbook
(the same goes for Set masterwb = ThisWorkbook).
Next, masterwb.Activate, you don't need to Activate the workbook, and it's also safer to also set reference to the sheet you want, you can also add the With statement, and use something like:
With masterwb.Worksheets("SheetName")
lr = .ListObjects("DataTbl").ListRows.Count ' number of rows in "DataTbl" table
You can also set an Object to your ListObjects.
Dim DataTbl As ListObject
Set DataTbl = masterwb.Worksheets("SheetName").ListObjects("DataTbl")
So later on, you can access it's properties much easier (and "cleaner").
For example:
lr = DataTbl.ListRows.Count ' <-- get the rows count of the table
and:
If DataTbl.DataBodyRange(lr, 1).Value = "" Then
And so on, you have way too many places where you Activate the 2 workbooks, and later use ActiveSheet and Selection.
If you describe better what you are trying to achieve, we can help you achieve it in a more reliable way.
Related
I am using the following line to do an INDEX/MATCH operation:
Range("F2:F" & TotalRowsSQL).Formula = "=INDEX('PATH\" & RåfilDate & "HørkramRå.csv'!AB2:AB" & TotalRowsRAW & ",MATCH(A2,'PATH\" & RåfilDate & "HørkramRå.csv'!A2:A" & TotalRowsRAW & ",0))"
Note that in reality, "PATH" is a true path...
Let me type a pseudo-code to help you make sense of that:
Range(MyRange).Formula = "=INDEX('FullPathToDifferentFile'!RangeInThatFile,MATCH(LookupValue,'FullPathToDifferentFile'!RangeInThatFile,0))"
When this is run the there are no exceptions, but when I open the file where the formula was executed only N/A has been returned.
Excel gives me a dialogue box that tells me that I can update the return values, and when I do it explains that the "different file" (called RåfilDate & "HørkramRå.csv") must be open in order to update the values. Opening the file immediatly fills the fields with all the expected values, showing my INDEX/MATCH to be written correctly...
The mystery is:
The file is open during the macro execution!
So I cannot understand why the fields aren't filled during the macro execution?
EDIT:
A theory was that the formula evaluated correctly during execution but returns N/A after macro execution. During execution I can see that it says N/A in all the fields. Regardless it was attempted to set:
Range("F2:F" & TotalRowsSQL).Value = Range("F2:F" & TotalRowsSQL).Value
This only resulted in the fields containing "N/A" as text rather than return from formula...
It looks to me like the open file is ignored during macro-execution, I just don't know why.
EDIT2:
It has been attempted to resolve the formula in VBA directly. I used the following code:
Dim wb1 As Workbook, wb2 As Workbook
Dim wb2path As String
Dim sh As Worksheet
Dim wf As WorksheetFunction
wb2path = "MyActualPath"
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open(wb2path)
Set sh = wb1.ActiveSheet
Set wf = Application.WorksheetFunction
wb1.Activate
For x = 2 To TotalRowsSQL
Range("F" & x).Value = Application.WorksheetFunction.Index(path & "!AB2:AB" & TotalRowsRAW, Application.WorksheetFunction.Match(A2, path & "!A2:A" & TotalRowsRAW, 0))
Next x
For x = 2 To TotalRowsSQL
Range("G" & x).Value = Application.WorksheetFunction.Index(path & "!AC2:AC" & TotalRowsRAW, Application.WorksheetFunction.Match(A2, path & "!A2:A" & TotalRowsRAW, 0))
Next x
For x = 2 To TotalRowsSQL
Range("H" & x).Value = Application.WorksheetFunction.Index(path & "!AU2:AU" & TotalRowsRAW, Application.WorksheetFunction.Match(A2, path & "!A2:A" & TotalRowsRAW, 0))
Next x
This unfortunatly only resulted in the following exception:
"run time error 1004: unable to get the match property of the worksheetfunction class"
I don't know why the match function isn't being accepted.
EDIT3:
It has been attempted to correct the code in the following way:
Dim wb1 As Workbook, wb2 As Workbook
Windows(Today & "HørkramProducentNavn").Activate
Set wb1 = ThisWorkbook
Windows(RåfilDate & "HørkramRå.csv").Activate
Set wb2 = ThisWorkbook
wb1.Activate
Dim sh As Worksheet
Set sh = wb1.ActiveSheet
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
For x = 2 To TotalRowsSQL
sh.Range("F" & x).Value = wf.Index(wb2.Sheets(1).Range("AB2:AB" & TotalRowsRAW), wf.Match(sh.Range("A" & x), wb2.Sheets(1).Range("A2:A" & TotalRowsRAW), 0))
Next x
For x = 2 To TotalRowsSQL
sh.Range("G" & x).Value = wf.Index(wb2.Sheets(1).Range("AC2:AC" & TotalRowsRAW), wf.Match(sh.Range("A" & x), wb2.Sheets(1).Range("A2:A" & TotalRowsRAW), 0))
Next x
For x = 2 To TotalRowsSQL
sh.Range("H" & x).Value = wf.Index(wb2.Sheets(1).Range("AU2:AU" & TotalRowsRAW), wf.Match(sh.Range("A" & x), wb2.Sheets(1).Range("A2:A" & TotalRowsRAW), 0))
Next x
Note that both workbooks are already open, but has no variable attached to them, at the start of this code. It has been tested that the correct windows do indeed activate when the Windows().Activate methods are called.
It throws the exception 1004 "Unable to get Match property of Worksheet function class"
This leads me to believe somthing is wrong with the arguments inside the Match statement, and debugging revealed something strange:
It threw the exception while x = 5. I would have thought x = 2, but no, it's 5. Wouldn't this mean the code was executed correctly for x= 2, 3 and 4 ?
Now just to be clear, the debugger tells me that x = 5 and that TotalRowsRAW = 25868. So they're both real numbers, and to my understanding the arguments in the Match statement should be valid?
By the way, I went to wb1 to check and see if it had figured out the first columns row 2, 3 and 4, but no. These fields are empty.
Thanks again for the help, I feel that I have a bit of a mystery on my hands...
Addendum: Goodness, would it give that exception if there is no match?? I checked, and that is the error it gives if there is no match!
Still odd that there is nothing in fields F2, F3 and F4 once the error occurs... Regardless, I'm going to try and implement Application.Match instead of WorksheetFunction.Match, since it doesn't throw an exection but just an N/A.
Thats because the values in the cells stay as formula and a direct reference to the other workbooks.
Try to add a
Range(MyRange).Value = Range(MyRange).Value
after writing the formulas to convert them to values.
That way you will end up with the actual values and no reference to the other workbooks.
Edit:
Based on the problem, maybe if you try to do the calculation inside of the vba instead of using the formula, with something like this:
Sub index_match()
Dim wb1 As Workbook, wb2 As Workbook
Dim wb2path As String
Dim sh As Worksheet
Dim wf As WorksheetFunction
Dim indexRange As Range
Dim matchRange As Range
Dim matchValue As String
wb2path = "" 'Add FullPathToDifferentFile
Set wb1 = ThisWorkbook
Set sh = wb1.ActiveSheet 'Worksheet to place the final values, can be also wb1.Sheets("nameofdesiredworksheet")
Set wf = Application.WorksheetFunction
Set wb2 = Workbooks.Open(wb2path)
wb1.Activate
Set indexRange = wb2.Sheets("Sheet1").Range("AB2:AB" & TotalRowsRAW) 'Sheet1 needs to be updated to FullPathToDifferentFile sheet
Set matchRange = wb2.Sheets("Sheet1").Range("A2:A" & TotalRowsRAW) 'Sheet1 needs to be updated to FullPathToDifferentFile sheet
matchValue = sh.Range("A2") 'Range with value for match formula
For x = 2 To TotalRowsSQL
sh.Range("F" & x).Value = wf.Index(indexRange, wf.Match(matchValue, matchRange, 0))
Next x
End Sub
Maybe some values needs to be adjusted, but I think it should do the trick.
I have an excel file where each column has varying products codes, descriptions, unit of measure, and 5 different prices (one for each distributor) in this order.
Workbook as it is:
I need to make 5 distinct .csv files, named after each distributor, each with code, discount (normally 0), one of the prices, MU and description, in this order.
What one of the CSVs should look like:
I can move columns around alright, the issues is that I can't seem to find a way to save the CSVs.
The code that I have (not mine) stops as it seems to be "unable to access the .csv" as it tries to save it.
Sub FornitoriToCSV()
Const FLDR = "C:\Users\HER-XV\Desktop" 'where to save files
Dim rng As Range, wb As Workbook, i As Long, rws As Long
Set rng = ActiveSheet.Range("A1").CurrentRegion 'data table
rws = rng.Rows.Count 'how many rows of data?
For i = 4 To rng.Columns.Count 'loop for each client column (starting at col4)
Set wb = Workbooks.Add 'add workbook
'copy data to workbook
With wb.Sheets(1)
.Range("A1").Resize(rws).Value = rng.Columns(1).Value
.Range("B1").Value = "Discount"
.Range("B2").Resize(rws - 1).Value = 0
.Range("C1").Resize(rws).Value = rng.Columns(i).Value 'client data
.Range("D1").Resize(rws).Value = rng.Columns(3).Value
.Range("E1").Resize(rws).Value = rng.Columns(2).Value
End With
'save the file using the client name
wb.SaveAs Filename:=FLDR & rng.Cells(1, i).Value & ".csv", _
FileFormat:=xlCSVUTF8, CreateBackup:=False
wb.Close False
Next i
End Sub
Any help would be much appreciated!
I want to insert data from source files in my excel model by opening the files and copying and pasting the values. I am just updating the values and not inserting formulas, formats or images etc.
The macro works fine and the inputs are pasted in my excel model. The last command is: ActiveWorkbook.Save
However, sometimes the macro cannot save the file (and I cannot see a regularity here - sometimes it works, sometimes it doesn't) and it displays the error message: "Errors were detected while saving. Microsoft Excel may be able to save the file by removing or repairing some features. To make the repairs in a new file, click continue. To cancel saving the file, click cancel."
Does anyone have an idea on how to fix this error? I am also posting the full code below. Thanks a lot in advance!
' Definitions
Dim i As Integer
Dim mapping_sheet, Worksheet_MVP, Dateiname_Input, Name_Worksheet_Input, Pfad_Input, Pfad_Datei, Zelle, Text As String
' Workbooks
Dim MVP, Auszug As Workbook
Pfad_Input = ActiveSheet.Range("B7").Value
Set MVP = ActiveWorkbook
Sheets("Automatisierung Datenupdate").Activate
Workbooks(MVP.Name).Application.Calculation = xlCalculationManual
Workbooks(MVP.Name).Application.CalculateBeforeSave = False
' 1. Updating Macro
' Copy Pasting Data
If ActiveSheet.Range("E11").Value = "Ja" Then
Dateiname_Input = ActiveSheet.Range("M11").Value
Name_Worksheet_Input = ActiveSheet.Range("D11").Value
Worksheet_MVP = ActiveSheet.Range("B11").Value
Pfad_Datei = Pfad_Input & "\" & Dateiname_Input
Sheets(Worksheet_MVP).Activate
Range("B6:ZZ300").Select
Selection.ClearContents
Set Auszug = Workbooks.Open(Filename:=Pfad_Datei)
Workbooks(Auszug.Name).Activate
Sheets(Name_Worksheet_Input).Activate
Range("A4:ZY298").Select
Selection.Copy
Workbooks(MVP.Name).Activate
Sheets(Worksheet_MVP).Activate
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues
' Close and Save
Workbooks(Auszug.Name).Activate
ActiveSheet.Range("A1").Copy
Workbooks(Auszug.Name).Close savechanges:=False
Workbooks(MVP.Name).Activate
Sheets("Automatisierung Datenupdate").Activate
Range("M11").Select
Selection.Copy
Range("C11").Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
' Save
Sheets("Automatisierung Datenupdate").Activate
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub
You mix up the concepts in your code which probably leads to the unexpected/irregular errors.
If you don't specify a data type (or object type) when you dim, the variable is Variant by default. e.g. "Dim MVP" is the same as "Dim MVP as variant"
You do assign your workbooks/worksheets to a variable but don't use the magic. Once set you can just refer to the workbook by referencing the varName.
Although variables are very powerfull, when you just want to use cell values it's better to store these in memory (e.g. an array)
Hereunder an alternative approach, only using the named workbooks/worksheets and minimising the interactions with the sheet by using arrays:
Sub ceci()
'dim vars to specific datatype
Dim wb As Workbook, sh As Worksheet, arr
Set wb = ThisWorkbook
Set sh = wb.Sheets("Automatisierung Datenupdate")
'To minimize the interactions with the sheet we store the data in memory, an array
'here we can access each cell by referencing our array(<rowCounter>, <columnCounter>
'e.g. arr(j,i) => if j = 1 and i = 1 we'll have the values of Cell A1
'we can dump these values anywhere in the activesheet, other sheet, other workbook, ..
Dim sh2 As Worksheet, wb2 As Workbook
arr = sh.Range("A1").CurrentRegion.Value2 'assuming you have data as of A1 we store all in the array, you can fine tune if needed though
If arr(11, 5) = "ja" Then 'E11
'source wb
Set sh2 = wb.Sheets(arr(11, 2)) 'b11
sh2.Range("B6:ZZ300").ClearContents
'wb2 - by specifically naming the workbooks and sheets we avoid unexpected errors
Dim sh3 As Worksheet, arr2, Pfad_Datei As String: Pfad_Datei = wb.Path & "\" & arr(11, 13) 'arr(7, 2) & "\" & arr(11, 13) 'b7 & m11
Set wb2 = Workbooks.Open(Filename:=Pfad_Datei)
Set sh3 = wb2.Sheets(arr(11, 4)) 'd11
arr2 = sh3.Range("A4:ZY298").Value2
sh2.Range(sh2.Cells(6, 2), sh2.Cells(UBound(arr2), UBound(arr2, 2))).Value2 = arr2 'dumb to sheet
'wb1
sh.Range("c11").Value = arr(11, 13) 'm11
End If
wb.Save
End Sub
Sorry if this comes across as flippant but I've spent the last 8 hours smashing my head against a wall with this. No matter what variant I try, this code constantly throws up errors of all degrees. I'm competent and I've taken SO MANY EXAMPLES and NONE OF THEM WORK. I'm beginning to think that theres something wrong with where the code is in my workbook. I've put it in Module1, where I normally keep all code.
The actual problem - copy/paste values from one workbook sheet to another after selecting the file from a popup prompt. That's it. The structure of the table is the same but it will need to be moved 5 rows up on the target sheet.
I've tried so many different types of code, which you can see as commented out when I try to iterate to something different. IT WILL NOT REFERENCE THE OPENED WORKBOOK CORRECTLY. Keeps throwing up errors like I'm trying to access some hidden darknet database instead of a file right next to it......
I've tried so many different approaches but they all end up with different errors. the above code gives me 'Runtime error 13. Type, mismatch.' on the line in the loop that tries to copy the code.
I think it all stems from excel not being able to correctly reference the opened file. even though it should.......................
Sub ImportEstimatorData()
Dim xTargetWb As Workbook 'Consolidator
Dim xSourceWb As Workbook 'Estimator
Set xTargetWb = ActiveWorkbook
Dim xTargetRng As Range 'Target row/column in new sheet, changes row starting
Dim xSourceRng As Range 'Source data from Estimator, Never changes
Dim xSourceSt As Worksheet
Dim xTargetSt As Worksheet
Sheets("CR Data").Activate
Set xTargetSt = ThisWorkbook.Sheets("CR Data")
Dim vFile As Variant
'fileToOpen = Application _
' .GetOpenFilename("Text Files (*.txt), *.txt")
'If fileToOpen <> False Then
' MsgBox "Open " & fileToOpen
'End If
'Dim vFile As Variant
'vFile = Application.GetOpenFilename("Excel-files,*.xlsx", 1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
'If vFile = "" Then Exit Sub
'Set targetworkbook
'Set xSourceWb = Workbooks.Open(vFile)
If Not Application.OperatingSystem Like "*Mac*" Then
' Is Windows.
vFile = Application.GetOpenFilename("Excel-files,*.xlsm", 1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If vFile = "" Then
Exit Sub
End If
Else
Exit Sub
End If
' Is a Mac and will test if running Excel 2011 or higher.
' If Val(Application.Version) > 14 Then
' Set xSourceWb = Select_File_Or_Files_Mac
' End If
' End If
'Workbooks.Open (vFile)
Set xSourceWb = Workbooks.Open(vFile)
'Workbooks(xSourceWb).Open
'Workbooks(xSourceWb).Activate
'Set Sheets for both Source & Target Workbooks
'Set xSourceSt = xSourceWb.Sheets("Output data GPE")
'Set xTargetRng = xTargetSt.Range(Cells(4, 2), Cells(80, 16))
Sheets("Output Sheet GPE").Activate 'Range(Cells(1, 1), Cells(2, 2)).Select
Set xSourceWb = ActiveWorkbook
'xSourceWb.Activate
'Set xSourceRng = xSourceSt.Range(Cells(4, 2), Cells(80, 16))
'xSourceRng.Copy xTargetRng
'Workbooks(xSourceWb).Worksheets("Output Sheet GPE").Range(Cells(8, 2), Cells(84, 16)).Copy Workbooks(xTargetWb).Worksheets("CR Data").Range(Cells(4, 2), Cells(80, 16))
For i = 8 To 84
For j = 2 To 16
Workbooks(xSourceWb).Worksheets("Output Sheet GPE").Cells(i, j) = Workbooks(xTargetWb).Worksheets("CR Data").Cells(i - 4, j)
'Debug error here
Next j
Next i
'Workbooks(xWb).Worksheets("CR Data").Range(Cells(4, 2), Cells(80, 16)).Copy Workbooks(xTargetWb).Worksheets("C").Range(Cells(4, 2), Cells(80, 16))
'Workbooks(xTargetWb).Worksheets("CR Data").Range(Cells(4, 2), Cells(80, 16)).PasteSpecial Paste:=xlPasteValues
'Workbooks(xTargetWb).Sheets("CR Data").Range(Cells(4, 2), Cells(80, 16)).Value = Workbooks(xSourceWb).Sheets("Output Sheet GPE").Range(Cells(4, 2), Cells(80, 16))
'xSourceWb.Close
'End If
'End With
End Sub'
Thank you BigBen! That was exactly it! I removed the 'workbooks' encloser and it worked :-)
Copy/paste response below for future perusal:
xSourceWb and xTargetWb are Workbook objects already. Don't enclose them in Workbooks. That said, you don't need a loop for this. – BigBen 16 hours ago
I am trying to copy the string values(column titles) from another workbook in row 4 as captions for checkboxes in the workbook where I am running the code. This is what I have so far and it is not working because it is showing the error message "Subscript out of range, run time error 9" Here is what I have. After the error message pops up the line marked below is highlighted. Can anybody help me please. Thank you very much.
Function CallFunction(SheetName As Variant) As Long
Dim text As String
Dim titles(200) As String ' Dim titles(200) As String ' Array
Dim nTitles As Integer
Dim wks As Worksheet
Dim myCaption As String
PathName = Range("F22").Value
Filename = Range("F23").Value
TabName = Range("F24").Value
ControlFile = ActiveWorkbook.Name
Workbooks.Open Filename:=PathName & "\" & Filename
ActiveSheet.Name = TabName
Set wks = Workbooks("Filename").Worksheets(SheetName).Activate ' <= Highlights this line ****
For i = 1 To 199
If Trim(wks.Cells(4, i).Value) = "" Then
nTitles = i - 1
Exit For
End If
titles(i - 1) = wks.Cells(4, i).Value
Next
i = 1
For Each cell In Range(Sheets("Sheet1").Cells(4, 1), Sheets("Sheet1").Cells(4, 1 + nTitles))
myCaption = Sheets("Sheet1").Cells(4, i).Value
With Sheets("Sheet1").checkBoxes.Add(cell.Left, _
cell.Top, cell.Width, cell.Height)
.Interior.ColorIndex = 12
.Caption = myCaption
.Characters.text = myCaption
.Border.Weight = xlThin
.Name = myCaption
End With
i = i + 1
Next
End Function
Subscript out-of-range typically indicates that a specified Worksheet does not exist in the workbooks Worksheets collection.
Otherwise, are you sure that the workbook specified by FileName is already open? If not, that will raise the same error.
Ensure that A) the file is already open (or use the Workbooks.Open method to open it), and B) ensure that such a worksheet already exists (if not, you will need to create it before you can reference it by name).
Update
You have Workbooks("FileName") where "Filename" is a string literal. Try changing it to simply Filename (without the quotation marks) (this seems like the OBVIOUS error).
Also worth checking:
I also observe this line:
ActiveSheet.Name = TabName
If the sheet named by SheetName is active when the workbook opens, then that line will effectively rename it, so you will not be able to refer to it by SheetName, but instead you would have to refer to it by Worksheets(TabName). ALternatively, flip the two lines so that you activate prior to renaming:
Set wks = Workbooks(Filename).Worksheets(SheetName).Activate
ActiveSheet.Name = TabName
For further reading: avoid using Activate/Select methods, they are confusing and make your code harder to interpret and maintain:
How to avoid using Select in Excel VBA macros
If that is the case, then you could do simply:
Workbooks(Filename).Worksheets(SheetName).Name = TabName