February 27, 2020, 5:43 pm
Hi Good Day All.
I run a macro and exit the excel application, i got below message pop up when trying to restart or shut down the laptop:
"Microsoft excel - This app is preventing you from restarting"
What's next is i have to click "Restart anyway" button to force restart/shut down the laptop.
Anyone got any idea what what is the problem? Is it the excel still running in the background? If yes how can i exit the excel completely? is there a macro code i can use to add in my existing macro?
Would appreciate for you help.
Thanks
↧
February 27, 2020, 7:04 pm
Hi All
Im trying to select cells in one column based on input values in another. The values are variable and could be input via a series of message boxes.
For example , in the first message box I would perhaps enter column B.
The next message box would ask lower and upper numbers. I might enter 25000 and 35000.
The last message box would ask for input of a second column. I might put column A.
The macro would then select the cells in A where the number is between 25000 and 35000 in column B.
Can someone suggest some code to satisfy this?
Grateful for any help.
↧
↧
February 27, 2020, 8:42 pm
Hi there,
I am trying to develop a code which would highlight row differences in Activeworksheet using loop. The rows range would be dynamic in every worksheet. Also, in some of the worksheets, there would be text in column A while in other worksheets in column D (so headings for each would again be in dynamic columns). I want to use a code wherein macro would search for first cell containing formula in the first row and then comparing rest of the row with the same formula. Same process would be repeated for remaining rows containing data. Would appreciate if someone can help me out.
Thanks,
↧
February 28, 2020, 12:39 am
Hi,
I'm working on a code which purpose is to calculate the correlation coefficient R^2 and pass its value to another equation, which calculates the Akaike Information Criterion.
I got stuck on the below given code. I try to calculate the Rsqr for each line (pair of Stress and Strain data), where the strain is already given and stress is calculated. When the code reaches the WorksheetFunction.Rsq it renders the error:
Run-time error '1004: Unable to get the RSq property of the WorksheetFunction class. Please advise what am I doing wrong?
Code:
Sub CalculateRsqr()
'This Sub calculates
' 1. the R^2 correlation coefficients for given polynom degree
' 2. The Akaike Information Criteria (AIC)
lRow = Cells(Rows.Count, 4).End(xlUp).Row
ReDim Strain(1 To lRow)
Strain = Application.Transpose(Range("Strain_R").Value)
ReDim Stress(LBound(Strain) To UBound(Strain))
Dim Rsqr As Variant
ReDim Rsqr(LBound(Strain) To UBound(Strain))
ReDim AIC(1 To 4)
'Rsqr for 4 deg polynom
Dim A(1 To 5) As Variant
For i = 1 To 5
A(i) = Cells(44, 8 + i).Value
Next i
For i = LBound(Strain) To UBound(Strain)
x = Strain(i)
Stress(i) = Round(A(1) * x ^ 4 + A(2) * x ^ 3 + A(3) * x ^ 2 + A(4) * x + A(5), 4)
Rsqr(i) = WorksheetFunction.RSq(Stress(i), x)
Next i
Thank you in advance
Regards
↧
February 28, 2020, 12:42 am
Hello all.
I have this code here that AlphaFrong kindly shared with me.
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Me.Unprotect Password:="Secret"
Cancel = True
Me.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
Me.Protect Password:="Secret"
End Sub
https://www.excelforum.com/excel-pro...ml#post5286089
I am wondering because the sheet is password-protected, is it possible to disable the keyboard use of CTRL+V so that the only way to paste in this particular sheet would be to double click, as the macro above requires?
If CTRL+V is used, maybe instead of the "This worksheet is password protected" pop-up message, the user will be asked to double click to paste?
Thanks!
↧
↧
February 28, 2020, 12:46 am
Hello everyone,
I've got the following problem.
I've got a macro, which consist of two macro's I've found over the internet. But when I run it, it gives an error 91 on the bold part.
I'm using Office 365.
Some code is Dutch, but what it says is not important.
Code:
Private Sub CommandButton1_Click()
Dim olMail As MailItem
Dim olNs As NameSpace
Dim olApp As Outlook.Application
Dim selection As selection
Set olApp = ThisOutlookSession.Application
Set olNs = olApp.GetNamespace("MAPI")
Set selection = olApp.ActiveExplorer.selection
Set olMail = selection(1)
onderwerp = olMail.Subject
Set olMail = Nothing
Set olNs = Nothing
Set selection = Nothing
Set olApp = Nothing
'-----------------------------
Dim Item As Object
Const olMsg As Long = 3
Dim m As MailItem
Dim savePath As String
projectnr = TextBox1.Value
If OptionButton1.Value = True Then
richting = "Ingekomen\"
ElseIf OptionButton2.Value = True Then
richting = "Uitgaand\"
Else
MsgBox ("Selecteer ingekomen of uitgaande mail!")
Exit Sub
End If
Set m = Item
savePath = "V:\" & projectnr & "\Correspondentie\e-mail berichten\" & richting '## Modify as needed
savePath = savePath & Format(Now(), "yyyy-mm-dd") & " " & onderwerp
savePath = savePath & ".msg"
On Error GoTo Fout
MsgBox savePath
m.SaveAs savePath, olMsg
MsgBox ("Mail succesvol opgeslagen!")
UserForm1.TextBox1.Value = ""
OptionButton1.Value = False
OptionButton2.Value = False
UserForm1.Hide
Exit Sub
Fout:
MsgBox ("Er is iets fouts gegaan bij het opslaan! Probeer het nog een keer!")
End Sub
↧
February 28, 2020, 1:21 am
Dear Sir,
Is it possible to copy information from "Registration" sheet to appropriate sheets? I have attached excel file. There are 10 numbers in column A and appropriate names in column B and appropriate amounts in column C.
You can see sheets named 1,2,3,4......10. The code should take name and amount from "Registration" sheet and find appropriate named sheet which is 1,2,3,4.....10 and copy Name to B2 and amount to C2.
For example, sheet name 5 should take information from "Registration" sheet which name is Terence and amount 67.7 (or number 5 should find sheet name 5 and copy name Terence and amount 67.7 from sheet "Registration to sheet 5 B2 and C2)
I hope explained correctly.
I appreciate your help.
Thank you in advance
↧
February 28, 2020, 1:41 am
OK so the below code and in attached example worksheet runs perfectly on my Win7 64bit, Excel32bit. But on my Win10 64bit, Excel 64bit the macro runs but nothing happens as a result (no items get copied or pasted, just retains the marching ants).
Any ideas where the fault may be? If someone could test on a 64bit version of Excel to just check if the error is repeated or if its just my machine that would be great also. The blue code below is intended for 64bit machines and the green is for 32bit.
The rest of the macro basically takes anything copied to the clipboard and pastes into a table but checks and limits the amount of columns being pasted, in order that the table doesn't have extra unwanted columns added.
Code:
' Written: February 23, 2020
' Updated: February 25, 2020 - Added missing PtrSafe keyword to several Declarations.
' Author: Leith Ross
' Summary: Reads the text saved on the clipboard without clearing the clipboard and returns it as a string.
Private Const CF_TEXT As Long = 1
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function OpenClipboard Lib "User32.dll" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "User32.dll" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "User32.dll" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "User32.dll" () As Long
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "User32.dll" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetOpenClipboardWindow Lib "User32.dll" () As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#Else
Private Declare PtrSafe Function OpenClipboard Lib "User32.dll" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "User32.dll" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "User32.dll" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "User32.dll" () As Long
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "User32.dll" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetOpenClipboardWindow Lib "User32.dll" () As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
#ElseIf VBA6 Then
Private Declare Function OpenClipboard Lib "User32.dll" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "User32.dll" () As Long
Private Declare Function GetClipboardData Lib "User32.dll" (ByVal wFormat As Long) As Long
Private Declare Function EmptyClipboard Lib "User32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "User32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetOpenClipboardWindow Lib "User32.dll" () As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
Function ReadClipboardData() As String
Dim Data() As Byte
Dim Field As Variant
Dim Fields As Variant
Dim k As Long
Dim Line As Variant
Dim Lines As Variant
Dim n As Long
Dim size As Long
Dim Text As String
#If VBA7 Then
Dim hData As LongPtr
Dim hMem As LongPtr
Dim hWnd As LongPtr
Dim ret As LongPtr
#Else
Dim hData As Long
Dim hMem As Long
Dim hWnd As Long
Dim ret As Long
#End If
hWnd = GetOpenClipboardWindow()
If hWnd = 0 Then
hWnd = OpenClipboard(hWnd)
hData = GetClipboardData(CF_TEXT)
If hData <> 0 Then
hMem = GlobalLock(hData)
size = GlobalSize(hMem)
ReDim Data(size)
CopyMemory Data(0), ByVal hMem, size
Text = StrConv(Data, vbUnicode)
ret = GlobalUnlock(hMem)
End If
CloseClipboard
End If
ReadClipboardData = Text
End Function
↧
February 28, 2020, 5:14 am
Hi to all
I had a value where it is 01
i'm using this code
Cells(k, 9).Value = C9V
The C9V has "01"
In my excel the paste value is 1 not 01
Why?????
↧
↧
February 28, 2020, 6:30 am
Hi Everyone,
Trust you're all doing well.
I have a code that hides rows if there is no value in a range.
Code:
Private Sub Worksheet_Calculate()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Me.Range("B41:B300")
If c.Value = "" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
c.EntireRow.RowHeight = 30
End If
Next c
Application.ScreenUpdating = True
End Sub
My issue is with this code, it takes a while to complete and slower down Excel.
Is there another way to make the same but faster?
Many thanks in advance and kind regards,
Filipe
↧
February 28, 2020, 6:46 am
Hey there fellas,
I got an excel file with 316 rows with HTML tags, I'd like to format them into excel text i.e. "Members of this group can:<UL><LI>View, create and edit time sheets.</LI><LI>Add approval requests to the approval flow for time sheets.</LI></UL>".
I found a couple of macros on line and the one I think could solve is trowing me this error "ActiveX component cant create object"
All text is in column C and I'd like to paste the result in another column.
Code:
Sub Sample()
Dim Ie As Object
'get the last row filled
lastRow = Sheets("Group Def & Usage").Range("C" & Sheets("Group Def & Usage").Rows.Count).End(xlUp).Row
'loop to apply the code for all the lines filled
For Row = 1 To lastRow
Set Ie = CreateObject("InternetExplorer.Application")
With Ie
.Visible = False
.Navigate "about:blank"
.document.body.InnerHTML = Sheets("Group Def & Usage").Range("C" & Row).Value
'update to the cell that contains HTML you want converted
.ExecWB 17, 0
'Select all contents in browser
.ExecWB 12, 2
'Copy them
ActiveSheet.Paste Destination:=Sheets("Group Def & Usage").Range("I" & Row)
'update to cell you want converted HTML pasted in
.Quit
End With
Set Ie = Nothing
Next
End Sub
Thanks in advance for the help! Edit: added text sample
↧
February 28, 2020, 7:06 am
Data.JPG
Need help with VBA code to determine the values for "Action" column in Excel.
Criteria for NO
1. Condition=N; Date within 2 years
2. Condition=Y; Date within 1 year
Criteria for YES
1. Condition=N; Date > 2 years
2. Condition=Y; Date > 1 year
3. Condition and Date=NULL
TIA.
↧
February 28, 2020, 7:20 am
Hello,
I thought this will be easy.
Code:
Option Explicit
'******CONSTANTS***************************
' Is used to color the background row of cells.
Const sRowColorBG As Variant = RGB(240, 240, 240)
Const sColColorBG As Variant = RGB(250, 250, 250)
How can I do/fix this?
Besides what is the best way to save a RGB value?
As always thank you.
LA
↧
↧
February 28, 2020, 8:03 am
Hi Everyone,
I'm running into an issue with a macro throwing "Run Time error '462': the remote server machine does not exist or is unavailable".
I have no idea what is going on and hopefully someone can show me? The error occurs at "IE.ExecWB 17, 0 ' Select All"
Thank You.
D
Code:
Private Sub WORKBOOK_OPEN()
Cells.Select
Selection.ClearContents
Range("A1").Select
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = False
.navigate "file:///C:\Users\Home\Dropbox\DAILY_SALES_REPORT\DAY_END.HTML" ' should work for any URL
Application.Wait (Now + TimeValue("0:00:05"))
IE.ExecWB 17, 0 ' Select All
IE.ExecWB 12, 2 ' Copy selection
Sheets("IMPORT_HTML").Select
Range("A1").Select
Application.Wait (Now + TimeValue("0:00:05"))
ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
False
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Selection.UnMerge
End With
IE.Quit
End Sub
↧
February 28, 2020, 11:26 am
This is a simplified example of what I'm trying to do. I have a form with one field inside a frame and one field outside of a frame.
The form looks like this:
https://imgur.com/a/lgUGL0P
I have the following code in the userform:
Code:
Private Sub TextBox1_AfterUpdate()
Call CheckFieldName
End Sub
Private Sub TextBox2_AfterUpdate()
Call CheckFieldName
End Sub
Sub CheckFieldName()
MsgBox ActiveControl.Name
End Sub
When I update TextBox1 and then click away, a message box show up that says "TextBox1" (as expected). When I do the same for TextBox2, the message box still shows "TextBox1", when I expected it to say "TextBox2". For some reason the frame is interfering with getting the name of the active control.
My question is: Is there a way to change the code in CheckFieldName so that it displays TextBox2 when TextBox2 is clicked away from and TextBox1 when TextBox1 is clicked away from?
In case it's relevant, this is a form that is being built inside Excel.
I've crossposted this question here:
https://www.reddit.com/r/vba/comment...rol_when_that/
↧
February 28, 2020, 11:28 am
Hi, I have a worksheet that has tables that I want to be dynamic. The tables are identical and in the same columns. The reason I need the rows to be dynamic is because there will always be a random number of entries in each one. The exact use is to document equipment in a room. I am currently using code to auto-hide rows, then unhide them as data is entered into the tables. Here is an example of that coding:
Code:
If IsEmpty(Range("Room1[EQUIPMENT MAKE]").Cells(1).Value) = True Then
rm2.EntireRow.Hidden = True
ElseIf IsEmpty(Range("Room1[EQUIPMENT MAKE]").Cells(1).Value) = False Then
rm2.EntireRow.Hidden = False
This is basically just looking at the first row in the table for each room, then auto-adding (unhiding the table for) the next room if data is entered in the first cell in the table.
Because I don't want to show a bunch of rows in a table that may or may not be used, I am only showing 2 rows in each table, and I have placed a form button at the top of the table that says "ADD A ROW." This is working perfectly, and adds a row to the table. The better solution would be to automatically add a row to the table when a certain cell is empty. The coding for this should be very similar to above, plus the coding that I have on the button. The problem is, I don't know how to call out the last row in the table, and not just pick the CURRENT last row. Is there a way to make this dynamic, where if data is entered into the first cell in the last row of the table, I can add a row to the end??
Thanks in advance for any help here!
↧
February 28, 2020, 11:57 am
Long story shorter, Im trying to check for open workbooks on our network drive at where I work. The short version is nothing works. Im passing the entire path as the parameter, since these arent on local machines only. Here is the code I've been using from this forum- *Edit: I guess I cant post the link
Code:
If FileInUse(TempPath) Then 'Do Something
MsgBox "Is Open"
Else
MsgBox "Closed"
End If
Code:
Public Function FileInUse(sFileName) As Boolean
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err.Description
On Error GoTo 0
Select Case iErr
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error iErr
End Select
End Function
Or This one
Code:
Public Function FileInUse(sFileName) As Boolean
MsgBox sFileName
On Error Resume Next
Open sFileName For Binary Access Read Lock Read As #1
Close #1
FileInUse = IIf(Err.Number > 0, True, False)
On Error GoTo 0
Besides these two, Ive tried other ways as well, and no matter what I do, it never works properly. Every time, despite the workbook being closed, it keeps kicking it back as open. And I cant get the rest of my code to run because of this one issue. If you have any ideas, please let me know, this seems so trivial, but is insanely infuriating.
↧
↧
February 28, 2020, 12:18 pm
https://www.excelforum.com/excel-for...scinerios.html
Helping an OP with a method to break ties in ranking by checking how the two individuals did when they raced each other in 1 of 20 heats.
I created a defined name ("AllHeats") which includes the 20 different heats (each heat has 4 people (column 1) with their place finished (column 2).
So, for example, the position of a person in a specific heat (let's say heat 17) would be found
Formula:
![]( "Select Code")
![copy to clipboard]( "Copy to Clipboard")
=MATCH(Player1, INDEX(AllHeats, 0,1,17),0)
Anyway, as part of the solution, I wanted to create a UDF which would return the name of the winning individual in any matched pair. (Everyone ran against each other once in the 20 heats). I get #VALUE! errors. The function is
=Winner(Player1 as range, Player2 as range) where Player1 and 2 refer to cells which contain the runners' names.
The code is
Code:
Function Winner(Player1 As Range, Player2 As Range)
Dim i As Integer, Trials As Range
Set Trials = Range("AllHeats")
For i = 1 To 20
If IsNumeric(WorksheetFunction.Match(Player1.Value & "*", WorksheetFunction.Index(Trials, 0, 1, i), 0)) And IsNumeric(WorksheetFunction.Match(Player2.Value & "*", WorksheetFunction.Index(Trials, 0, 1, i), 0)) Then
If WorksheetFunction.Index(Trials, WorksheetFunction.Match(Player1.Value & "*", WorksheetFunction.Index(Trials, 0, 1, i), 0), 2, i) < WorksheetFunction.Index(Trials, WorksheetFunction.Match(Player2.Value & "*", WorksheetFunction.Index(Trials, 0, 1, i), 0), 2, i) Then
Winner = Player1.Value
Else
Winner = Player2.Value
End If
End If
Next i
End Function
Where's the error coming from? If I break it up into individual formulas in Excel, they all work.
Also, how do I step through a UDF. F8 doesn't seem to help me, nor does setting up toggle break points (F9). Thanks in advance.
↧
February 28, 2020, 12:21 pm
I created a macro to create a pdf from an Excel form. I have 7 co-workers using this form and only 1 person is getting this run-time error. Is there a setting on his computer I am missing? The code is below:
Code:
Sub Save_to_PDF()
'
' Save_to_PDF Macro
'
ChDir "C:\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\RVPPM Form.pdf", Quality:=xlQualityStandard, IncludeDocProperties _
:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
↧
February 28, 2020, 12:35 pm
Hello everyone,
In the columns of my Excel sheet I have created list boxes.
I would like a few specific columns to have the option of placing multiple values in one cell (via a list box). For other columns it is required that only one value will be placed in the cells.
Searching through links mentioned on this forum led me to the "View Code" option on the tab of the sheet. There I found the code below. It indicates that only column 17 offers the option of placing multiple values in one cell. What changes can I make in this code to ensure that also column 20 and 21 get the option?
Code:
If Target.Count > 1 Then Exit Sub
On Error Resume Next
Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False
If Not Application.Intersect(Target, xRng) Is Nothing Then
xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If Target.Column = 17 Then
If xValue1 <> "" Then
If xValue2 <> "" Then
If xValue1 = xValue2 Or _
InStr(1, xValue1, " " & vbCrLf & xValue2) Or _
InStr(1, xValue1, vbCrLf & xValue2 & "") Then
Target.Value = xValue1
Else
Target.Value = xValue1 & " " & vbCrLf & xValue2
End If
End If
End If
End If
End If
Application.EnableEvents = True
End Sub
Can anyone help me? Thanks in advance!
Kind regards,
P
(Sorry, I cannot add an example Excel sheet, because the document is from my work which has privacy related writings in the properties of the document, and which I cannot remove. At home I dont have Excel, so I cannot recreate an Excel sheet. I hope this will not be a problem and that I have described my problem sufficiently.)
↧
