I am working in Excel 2016. I currently created a macro that will loop through all open workbooks and grab the data in them if they start with the word "report". The issue I am trying to solve now is how to enable editing. If the users enable editing after downloading all reports to be combined there is no issue with the macro. They run into issues with the macro not grabbing the data if they missed that button.
While they are not working with that many workbooks, I am trying to make it easier for them. The code that I have posted will do the first 3 workbooks and then continue looping through the remaining 5 but will not "Enable Edit".
Sub EnableEdit()
Dim bk As Workbook
Dim w As Long, wCount As Long
wCount = Application.ProtectedViewWindows.Count
Set wsh = ThisWorkbook.Worksheets("Data")
On Error Resume Next
If wCount > 0 Then
For w = 1 To wCount
Application.ProtectedViewWindows(w).Activate
Application.ProtectedViewWindows(w).Edit
If Left(ActiveWorkbook.Name, 6) = "report" Then
ActiveWorkbook.Worksheets(1).Range("A1:Z1").Copy _
Destination:=wsh.Range("A1")
nrow = wsh.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveWorkbook.Worksheets(1).Range("A2:Z500").Copy _
Destination:=wsh.Range("A" & nrow)
ActiveWorkbook.Close
End If
Next w
End If
On Error GoTo 0
End Sub
Application.ProtectedViewWindows appears to be a collection of all the protected-view windows. As soon as you execute the .Edit method on one of those protected-view windows it is no longer in protected-view mode and is therefore removed from the collection.
This means that when you Edit the first member of the collection (when w is 1), what was the second member now becomes the first member, what was the third member now becomes the second, etc. And then on the next iteration of your loop (when w is 2) your code is therefore looking at the original third member, having completely ignored looking at the original second member.
The easiest way to fix the issue is to loop through the array in reverse order, i.e. use:
For w = wCount To 1 Step -1
Related
I am getting completely crazy about this issue, please help me.
I have made a shell script that writes in a text file the path of some images that are stored in a folder. Then I use an excel code to read each path and write it in an excel cell.
I have then made a code that should take that path and use it to insert the picture. I have tried with Pictures.insert(path) and shapes.addpictures "path", but I have the same issue every time, the picture can't be loaded.
What's weird, is that, if I manually insert the picture before and then delete it, the code will perfectly load the picture. But if it's the first time then no.
The paths that I'm using look like that: "/Users/theodorebedos/Documents/code_tilly/new_pict_tilly/IMG_9040.jpg"
I'm using a mac, maybe that matters?
Private Sub Convert_Img()
Dim myPict As Picture
Dim PictureLoc As String
Dim EndPictRow, i As Integer
Dim StartPath As String
If Worksheets("Main").Cells(3, 1).Value <> "" Then
EndPictRow = Worksheets("Main").Range("A2").End(xlDown).Row
For i = 3 To EndPictRow
PictureLoc = Worksheets("Main").Cells(i, 1).Value
Worksheets("Main").Cells(i, 1).ClearContents
Worksheets("Main").Cells(i, 1).ColumnWidth = 30
Worksheets("Main").Cells(i, 1).RowHeight = 150
ActiveSheet.Shapes.AddPicture PictureLoc, False, True, Worksheets("Main").Cells(i, 1).Left, Worksheets("Main").Cells(i, 1).Top, Worksheets("Main").Cells(i, 1).Width, Worksheets("Main").Cells(i, 1).Height
Next i
End If
End Sub
Edit:
When I use "Pictures.insert" or "shapes.addpicture path, true, true " I have no error message in VBA but I have in excel instead of my picture, a blank image with inside an error message like this:
image
If I use "shapes.addpicture path, FALSE, true" then I have an error message like this but no image at all is loaded: image 2
And then an error 1004 like that:
image3
And if I do the process to have image 1, then I save the document, reopen it, I'll have this directly: image 4
Thanks for you help. It will be much appreciated.
I streamlined your code so it becomes possible to see what it's doing. Note that I avoided reading values from the cell's properties which were just set or are obvious.
Once the column width has been set, the width of all cells in it are the same.
The Left property of all cells in a column is always the same.
If the column is column A, the Left is always 0.
Of course, what you tried to achieve is to enter a value only once. That is good practice but to read properties from the sheet is slow. The faster way - less code volume and better readable, too - is to declare a constant at the top and use that name in the code.
So you end up with this code.
Private Sub Convert_Img()
Const ClmWidth As Single = 30
Const RowHight As Single = 150
Dim EndPictRow As Long, R As Long
' sorry, I recommend i for arrays and R for rows (C for columns)
With Worksheets("Main")
' End(xlDown) will find the first blank cell below the base cell.
' There might be more filled cells further down.
' End(xlUp) will find the first used cell above the base cell
' disregarding more blanks above that one.
EndPictRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' no need to set the column width multiple times in the loop
.Columns(1).ColumnWidth = ClmWidth
' this loop will never run if R < EndPicRow
For R = 3 To EndPictRow
With .Cells(R, 1)
.RowHeight = RowHight
' this will work only once:-
.Worksheet.Shapes.AddPicture CStr(.Value), False, True, 0, .Top, ClmWidth, RowHight
End With
Next R
End With
End Sub
The reason why it works only once becomes quite obvious. The new picture takes its source path from the cell's Value. Of course, once you insert a picture (image) in the cell that value can't be the path (string) anymore. If you run the code a second time it will fail. However, if that is your need, it should be possible to extract the path from the formula that defines the picture in the cell. Given that the picture itself isn't present at that location the formula should either hold the path or a reference to a location within the workbook's background data, depending upon how it was loaded.
Ok, so it's not perfect yet, but I put the loop off and I used Dir() as you said #Variatus.A pop-up window like this opened when I executed the command Dir(). It asked me the authorisation to access the file. I pressed yes and then it worked.
It worked but only for that file. So I guess, I am on the right way now and I need to find how to give access to all the files in that folder before running the code. I can't do it for all of them.
Thank you very much.
I hope someone will benefit from this old thread. As it turns out this is some sort of a permission issue also noted already in one of the comments, possibly only occurring with Excel 16 macros on OSX.
It seems like Excel is lacking the permissions to access the resources linked and is not asking for them. We need to grant permissions to all files in the folder. The following code demonstrates how to achieve this, given the identifier to build the paths is in Column A2:20. Run this macro (adjust the way the path is built), then grant access once the dialogue appears:
Sub GrantAccess()
Dim cName As Variant
Dim files() As Variant
Set xRange = ActiveSheet.Range("A2:A20")
For Each cell In xRange
ReDim Preserve files(1 To cell.Row - 1)
cName = "/Users/adjust-your-path/path" & Cells(cell.Row, "A") & "_thumb_600.png"
files(cell.Row - 1) = cName
Next
fileAccessGranted = GrantAccessToMultipleFiles(files)
End Sub
Code used:
Sub URLPICInsertMM()
Dim cShape As Shape
Dim cRange As Range
Dim cColumn As Long
Dim cName As String
Dim img As Picture
Application.ScreenUpdating = False
Set xRange = ActiveSheet.Range("B2:B10")
For Each cell In xRange
'cName = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
' files are located in thumbs sub-directory
cName = "/Users/.../IonChannels/thumbs/" & Cells(cell.Row, "A") & "_thumb_300.png"
Set img = ActiveSheet.Pictures.Insert(cName)
img.Select
Set cShape = Selection.ShapeRange.Item(1)
If cShape Is Nothing Then GoTo line22
Cells(cell.Row, "C").Value = "file://" & cName
Set cRange = Cells(cell.Row, cell.Column)
With cShape
.LockAspectRatio = msoTrue
'If .Width > cRange.Width Then .Width = cRange.Width
If .Height > cRange.Height Then .Height = cRange.Height
.Top = cRange.Top + (cRange.Height - .Height)
.Left = cRange.Left + (cRange.Width - .Width)
End With
line22:
Set cShape = Nothing
Range("T2").Select
Next
Application.ScreenUpdating = True
End Sub
Edit:
Evidence:
I created a simple test sheet (the idea is to load some protein visualization thumbs into an excel sheet) with an identifier in Column A, image file descriptors are constructed from the identifier + path and file extension.
The image is inserted into Column B and the file descriptor as text into Column C.
When I ran the macro for the first time, only the first image was loaded. Excel formats the file descriptor as a hyperlink. When clicking the file:///... link, Excel opens a dialog that asks to grant permissions to that file (screenshot). If I grant access and accept warnings, then run the macro again, the image appears.
After running macro again, image is displayed:
I keep having an issue with some code in VBA Excel was looking for some help!
I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.
So far my code is:
Sub main()
Dim cName As New Collection
For Each celli In Columns(3).Cells
Sheets(2).Activate
On Error GoTo raa
If Not celli.Value = Empty Then
cName.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
Sheets(3).Activate
Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
Resume Next
End Sub
When I try to run the code it crashes Excel, and does not give any error codes.
Some things I've tried to fix the issue:
Shorted List of Items
Converted phone numbers to string using cstr()
Adjusted Range and offsets
I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!
Updated:
Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(3).Cells
On Error GoTo raa
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
Resume Next
End Sub
Update2:
Used hold.Exists along with an ElseIf to remove the GoTo's. Also changed it to copy and paste the row to the next sheet.
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(2).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub
When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).
When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean.
The short answer to your question, now that I have the context out of the way, is that you can first check (if Not hold.exists(CStr(celli.Value)) Then) and then add if it does not already exist.
(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:
Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
tResult = True
On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
RangeExists = tResult
End Function
New to writing code in VBA, and I need to add in a way to count/track how often a macro is used. I'm struggling to find any examples of a code that would perform this function. Requesting any examples there might be for this.
Excel VBA doesn't have any built-in storage that persists across sessions - when the application is closed, all variables are released. However you do have a readily available source of storage - the workbook itself. Here's one way to do it:
Make a worksheet called Counter (or something). Optionally, hide it so no one messes with it. Then, when your macro runs, increment the value of Cell(1,1), which will hold your counter value.
Dim runCount As Integer
Dim counterWS As Worksheet
Set counterWS = ThisWorkbook.Worksheets("Counter")
If counterWS.Cells(1,1) <> vbNullString And IsNumeric(counterWS.Cells(1,1)) Then
runCount = counterWS.Cells(1,1) + 1
Else
runCount = 1
End If
counterWS.Cells(1,1) = runCount
Use static when declaring your variable.
From "EXCEL" Ytics:
Can we declare a variable to retain its value from a previous run?
Static Declaration within a procedure limits the variable to that procedure – but helps retain values of variables from previous runs, until forcefully reinitialized by explicit declaration using ‘ReDim’ or value setting.
Sub MySub( )
Static Cnt As Integer
Dim Msg As String
Cnt = Cnt + 1
Msg = “You’ve run the procedure ” & Cnt & ” times”
MsgBox Msg
End Sub
This will build a table for you on a hidden sheet showing all historical uses of the macro up to the nth time the macro was used along with a time stamp so you know when the macro was used. With this, you can use equations to extract exact data that you want as well. If you want a cell to show usage count, just to "Countif("A:A","*")-1” ... (minus 1 to ignore the header in A1)
To Implement this macro:
Create a new sheet titled "MacroCount"
Set A1 = "Instance"
Set B1 = "Time Stamp"
I would personally make this the last thing the macro does so it will only count the instance once the macro completes all of its assigned duties.
Also, Remove the "Sub MacroCount()" & "End Sub" from the below code.
Sub MacroCount()
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("MacroCount")
Application.Screenupdating = False
WS.Visible = True
Dim LRow As Long
LRow = WS.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
WS.Range("A" & LRow).Value = LRow - 1
WS.Range("B" & LRow).Value = Now()
WS.Visible = False
Application.Screenupdating = True
End Sub
I am trying to get better coding practice and using generic function.
I am working with several workbooks from a master file.
For example if I want to get the last row I am using the following line of code.
LastRow=Range("A" & Rows.Count).End(xlUp).Row
To retrieve the value with a function I build the function:
-Function 1
Function GetLastRow() As Integer
GetLastRow = Range("A" & Rows.Count).End(xlUp).Row
End Function
Now from my Sub Main() I want to use GetLastRow() for different workbooks or worksheets. I think it is not a good thing to Activate the workbook before calling my function.
Then should I transmit each time the workbook name and worksheet number to my function and change my function to:
-Function 2
Function GetLastRowIn(sWb As String, iWs As Integer) As Integer
GetLastRowIn = Workbooks(sWb).Worksheets(iWs).Range("A" & Rows.Count).End(xlUp).Row
End Function
Or is there a better/simpler way to transmit the workbook and worksheet in which I want to apply the function while keeping it with no argument as in Function 1?
Thanks for your answers!
To make a function more generic you can allow for some flexibility,
but also impose some rulles for the function calls
Generic Function
Option Explicit
Public Function GetLastRow(ByRef ws As Worksheet, Optional ByVal fromCol As Long = 1) As Long
Dim invalidWS As Boolean, lastRow As Long
If Not ws Is Nothing Then 'check 1st param
On Error Resume Next 'check that ws reference is valid (delted WS invalidates ws)
invalidWS = Len(ws.Name) > 0
invalidWS = Err.Number <> 0 'No error if Err.Number = 0
On Error GoTo 0
If Not invalidWS Then
If fromCol > 0 And fromCol <= ws.Columns.Count Then 'validate 2nd param
lastRow = ws.Cells(ws.Rows.Count, fromCol).End(xlUp).Row
'check if WS.fromCol is empty
If lastRow = 1 And Len(ws.Cells(1, fromCol)) = 0 Then lastRow = 0
End If
End If
End If
GetLastRow = lastRow
End Function
Test Sub
Public Sub TestGetLastRow()
'show results in the Immediate Window (VBA Editor: Ctrl+G)
Debug.Print GetLastRow(Sheet1, 1) 'CodeName of WS
Debug.Print GetLastRow(Workbooks(1).Worksheets(1)) 'WS Index
Debug.Print GetLastRow(ActiveWorkbook.Worksheets("Sheet3"), 3) 'WS name (string)
Debug.Print GetLastRow(ThisWorkbook.Worksheets(1), 0) 'invalid column (or -3)
Dim ws As Worksheet
Set ws = Sheet3
Application.DisplayAlerts = False
ws.Delete 'invalidate ws variable
Application.DisplayAlerts = True
Debug.Print GetLastRow(ws, 1) 'function call with invalid ws object
End Sub
Always use Option Explicit to allow the compiler to catch spelling mistakes in variable names
Validate all input
The function call may not include a valid Worksheet, or column number
Allow the Worksheet to be specified by CodeName, WS Index, or WS Name (string)
Allow a default column ID by using Optional for the 2nd parameter
Impose the call to send only a Worksheet object as the first parameter
If you accept strings for it you need to first check that Worksheet("Invalid") exists
Impose the call to request column by Index
If you allow strings in column ID you need to check that the string is between "A" and "XFD"
String length between 1 and 3, and also not allow strings like "XYZ"
This would require a separate function that checks each letter in the string
Strings also create potential for more maintenance if MS decides to increase max columns
Make the function for one purpose (like you did) - don't include other functionality later on
The function should be self contained
Able to detect and handle all possible errors and unexpected input
And generate the most generic and usable output
By returning a 0 in this particular function, calls that expect a valid number will error out for row 0
So you may want to change it to return 1 even if the sheet is empty
and check the top cell if blank after the call returns
As a note:
several workbooks from a master file
A Workbook is a file
A Worksheet is a tab inside a file (a file can contain multiple sheets / tabs)
Always be explicit with all object
Range("A" & Rows.Count).End(xlUp).Row implicitly uses ActiveWorkbook.ActiveSheet
Translates to ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If you need to work with several Workbooks and Worksheets, fully qualify your calls
`Workbooks("Book1").Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
`Workbooks("Book2").Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
so Excel can access the exact object you need to work with
If you use full references your code doesn't depend on active objects
- If a user activates a different Workbook, or Worksheet the code will continue to work without errors
Hope this helps
PS. When using row variables always declare them as Long to be able to handle more than the Integer maximum of 32,767 - currently Excel has a max of 1,048,576 rows (in the future this max can increase even higher)
I found VBA code and modified it but it didn't work.
Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim i As Integer
Dim j As Integer
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
wdFileName = Application.GetOpenFilename()
j = 1
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
For i = 1 To .Tables.Count
With .Tables(i)
'copy cell contents from Word table cells to Excel cells
For iRow = 2 To .Rows.Count
For iCol = 1 To .Columns.Count
Cells(j, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Next iCol
j = j + 1
Next iRow
End With
Next i 'Next Table
End With 'End of the document
Set wdDoc = Nothing
End Sub
I have a Word document, with 750 pages, with a table on each page. I want to import the contents of the tables into an Excel file (with the exception of the first line of each table as that is the column names).
It throws an error (As shown in picture) -- Automation Error -- "Run-time Error 2147418105 (80010007)".
From your screenshot it appears you got through row 10 and started row 11 before the error occurred. Without seeing the full document or knowing the table schema I would try one or more of the following approaches:
Try setting breakpoint before word crashes, then step through to see if specific data or some other issue may be the culprit. (At the Row loop (For iRow = 2 To .Rows.Count) or add IF iRow=10 THEN debug.break then step into each line (Debug>Step Into (F8)) from there.).
If table ends near 10 rows then try closing wdDoc (Set wdDoc = Nothing), reopen, and continue import starting right where you left off. This sounds impractical, but if it works around the bug then you can try adjusting some values and narrowing down the root cause.
Run this VBA on a computer that has lots of free RAM. MS Word may be loading entire 750-page document into memory, then hitting OutOfMemory, pagefile thrashing, or other OS resource limit that devolves into app crash.
Try splitting the 750-page document into 8 files with no more than 100 pages per file. Then loop through each. If that works then look into computer resource limits or issue with Word size limitations.
FYI: I've seen some issues with Word stability at ~1000 pages but I had lots of screenshots and other formatting goodies in that example (and I found solution that kept it split into 27 separate reference detail-level sections with an overall <50-page top-level document loosely referring to them.)
A Year late and short of a known fix, but this debugging checklist might help you or others who stumble upon this thread :-). I'm working with very similar routine (and just started searching for how to pull statistics for each table :-)). Cheers and good luck!