I have a code that adds a data label to the selected point on a chart. The section of code below takes about 4 seconds. And that is too long for the take I am working on. Any ideas?
My computer has reasonable specs. and I am using Office 2013.
Set SRS = ChartObjects.SeriesCollection(Arg1)
If SRS.Points(Arg2).HasDataLabel = False Then
ChartObjects.SeriesCollection(Arg1).Points(Arg2).HasDataLabel = True
ChartObjects.SeriesCollection(Arg1).Points(Arg2).DataLabel.Text = "Case: #" + CStr(CaseCoUnter)
Select Case True
Case Upper
ChartObjects.SeriesCollection(Arg1).Points(Arg2).DataLabel.Position = xlLabelPositionAbove
Case Lower
ChartObjects.SeriesCollection(Arg1).Points(Arg2).DataLabel.Position = xlLabelPositionBelow
End Select
End If
I too have an Intel processor, but at a slightly lower speed of 2.60 GHz, and only 8 GB of RAM. Nevertheless, when I tested your posted code, I clicked on a data point and it added the data label somewhat instantaneously. So if it's taking about 4 seconds for you, it may be because you have other code within the event procedure that is slowing it down. In any case, your code could be re-written as follows...
Set SRS = ChartObjects.SeriesCollection(Arg1)
With SRS.Points(Arg2)
If .HasDataLabel = False Then
.HasDataLabel = True
.DataLabel.Text = "Case: #" + CStr(CaseCoUnter)
Select Case True
Case Upper
.DataLabel.Position = xlLabelPositionAbove
Case Lower
.DataLabel.Position = xlLabelPositionBelow
End Select
End If
End With
Related
About four years ago I built an Excel (Version unknown) app in vba to view Videos in a form. It worked fine at that time. I didn't use the program for quiet a while, and now (Excel 365 V2203) the player starts to flicker, as soon as the program tries to assign a new .width or .heigth to the player (Code below).
When I comment out the block, everything works fine. Yet, the player window is too small.
Even reassigning .Width parameter the value dWith does not lead to a problem
When I resize the Player Window in the properties window, the size is automatically reset during initalisation of the form.
Any ideas? Thanx in advance.
Gin
Private Sub UserForm_Activate()
Dim dHeight, dWidth, dMaxHeight As Double
Dim i As Double
i = Timer
Do While Timer < i + 1 'Seconds
DoEvents
Loop
' No problems if next block is commented out (yet, video too small)
With WindowsMediaPlayer1
.settings.autoStart = False ' also does flicker, if set to True
dWidth = .Width
.Width = 2 * dWidth
.stretchToFit = True ' also does flicker, if set to False
End With
' End of block (to comment out in order to avoid problems)
End Sub
```
I have a Word document where the user will input codes for standard comments, usually using an outline format like bullets 1, a, 2, and 3. The user saves and closes the Word document. Then the user can open a Comments Excel document and click on a button that will ask the user to find which Word document they want to replace the codes (column A) with the Text value (column C) in the Excel document. The code and process work great except when the value exceeds 255 characters, which will happen quite often. I've read about using the clipboard in doing this, but I wasn't sure how to implement it into my existing code. Thank you for any help. Sorry if I am not posting this correctly, new to this forum.
Sample comments in Word:
B401
B402
M317
This is my own comment
P203
Sample in Excel file (each row separated by a comma):
Column A rows- B401, B402, M317, P201, P203
Column B rows- Handrail compliance, Handrail Extensions, HVAC, Water Building, Water System
Column C rows-
Handrails shall comply with section 1014 of the 2015 International Building Code.,
Handrails shall return to a wall guard or walking surface. (See Section 1014.6 of the 2015 International Building Code.),
No HVAC drawings shown; will handle in the field.,
Where water pressure within a building exceeds 80 psi (552 kPa) static, an approved water pressure reducing valve conforming to ASSE 1003 or CSA B356 with strainer shall be installed to reduce the pressure in the building water distribution piping to 80 psi (552 kPa) static or less. Exceptions to this requirement are service lines to sill cocks and outside hydrants, and main supply risers where pressure from the mains is reduced to 80 psi (552 kPa) or less at individual fixtures. (See Section 604.8 of the 2015 International Plumbing Code.),
A water test shall be applied to the drainage system either in its entirety or in sections. If applied to the entire system, all openings in the piping shall be tightly closed, except the highest opening, and the system shall be filled with water to point of overflow. If the system is tested in sections, each opening shall be tightly plugged except the highest openings of the section under test, and each section shall be filled with water, but no section shall be tested with less than a 10-foot (3048 mm) head of water. In testing successive sections, at least the upper 10 feet (3048 mm) of the next preceding section shall be tested so that no joint or pipe in the building, except the uppermost 10 feet (3048 mm) of the system, shall have been submitted to a test of less than a 10-foot (3048 mm) head of water. The water shall be kept in the system, or in the portion under test, for at least 15 minutes before inspection starts. The system shall then be tight at all points. (See Section 312.2 of the 2015 International plumbing Code.) Plastic piping shall not be tested with air. An air test shall be made by forcing air into the system until there is a uniform gauge pressure of 5 pounds per square inch (psi) (34.5 kPa) or sufficient to balance a 10-inch (254 mm) column of mercury. This pressure shall be held for a test period of at least 15 minutes. Any adjustments to the test pressure required because of changes in ambient temperature or the seating of gaskets shall be made prior to the beginning of the test period. (See Section 312.3 of the 2015 International Plumbing Code)
Existing Excel Code that works until the 255 character limit:
Sub Replace()
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Word Files", "*.docx; *.docm", 1
.Show
fullpath = .SelectedItems.Item(1)
End With
Dim pathh As String
Dim pathhi As String
Dim oCell As Integer
Dim from_text As String, to_text As String
Dim WA As Object
pathh = fullpath
Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True
For oCell = 1 To 500
from_text = Sheets("Comments").Range("A" & oCell).Value
to_text = Sheets("Comments").Range("C" & oCell).Value
With WA.ActiveDocument
Set myRange = .Content
With myRange.Find
.Execute FindText:=from_text, ReplaceWith:=to_text, Replace:=1
End With
End With
Next oCell
End Sub
The fault is in the function you are using which can't accept a parameter of the size you want. So, we have to work around it a bit. Try replacing your for loop with this:
For oCell = 1 To 500
from_text = Sheets("Comments").Range("A" & oCell).Value
to_text = Sheets("Comments").Range("C" & oCell).Value
If from_text = "" Then Exit For
WA.Selection.Find.ClearFormatting
WA.Selection.Find.Replacement.ClearFormatting
With WA.Selection.Find
.Text = from_text
.Forward = True
.Wrap = 1
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
IF WA.Selection.Find.Execute Then
WA.Selection = to_text
End If
Next oCell
The goal here is just to use find to select the "from" text, and then assign that selection with the intended "to" text value. This avoids the replace function itself. Tested successfully on my end. The code more closely matches what Word generates in its macro recorder, however some VBA constants have been replaced with numeric values, so buyer beware.
Hope it helps
This works on my normal laptop 16Gb ram and excel office 365, but when I am using my tablet pc with 4Gb ram and excel office 365. When I initialise a particular userform that contains two webbrowsers, it causes excel to crash, I do not receive any error messages, it looks like its thinking about it and then excel just closes and re-opens with a recovered version. All my other code works fine.
This works ok on my laptop with 16Gb ram the version of windows and excel are the same, the only difference is the 4Gb. I was expecting it to only take longer with the difference in ram, is it a memory issue?
When I blanked out the following lines the userform loads fine (just obviously without the webpages being navigated to)
Me.WebBrowser1.Silent = True
Me.WebBrowser1.Navigate "https://www.nutracheck.co.uk/CaloriesIn/"
Me.WebBrowser2.Navigate "about:blank"
Me.WebBrowser2.Document.Write "<img style=""width:100%;""
src=""https://media.giphy.com/media/MIY4jpusckRmU/giphy.gif"">"
WebBrowser2.Document.Body.Style.Border = "none"
WebBrowser2.Document.Body.Scroll = "no"*
Private Sub UserForm_Initialize()
With Application
' here I have code to format and position labels and command buttons on
'userform according to screen size
End With
'next line suppresses script errors in the web browser window
Me.WebBrowser1.Silent = True
Me.WebBrowser1.Navigate "https://www.nutracheck.co.uk/CaloriesIn/"
Me.WebBrowser2.Navigate "about:blank"
Me.WebBrowser2.Document.Write "<img style=""width:100%;""
src=""https://media.giphy.com/media/MIY4jpusckRmU/giphy.gif"">"
With Application
WebBrowser1.Top = .Top + 40
WebBrowser1.Left = AddARecipe.Left + (AddARecipe.Width * 0.48)
WebBrowser1.Height = .Height - 40
WebBrowser1.Width = AddARecipe.Width * 0.5
End With
With Application
WebBrowser2.Top = .Top + 60
WebBrowser2.Left = 0 '10
WebBrowser2.Height = (AddARecipe.Width * 0.243)
WebBrowser2.Width = (AddARecipe.Width * 0.45)
WebBrowser2.Visible = False
WebBrowser2.Document.Body.Style.Border = "none"
WebBrowser2.Document.Body.Scroll = "no"
End With
End Sub
When the code is run unaltered, and I step through the code no error messages come up, its just at "end sub" excel closes.
I have a Microsoft Form 2.0 Frame Control with three option buttons. The name of the Frame Control is Side, three option button captions are X, O, and Random with names xOption, oOption, and randomSide respectively.
The code runs fine, except upon startup, if I open Excel and run the program immediately, it will give me an Error 91, note that one of the options (X, O, or Random) is already selected. In order to get rid of this error, I need to explicitly select another option, then the error goes away. I don't know why this happens. Here is the sub for the Frame Control
Public Sub Side_Click()
sideLetter = Side.ActiveControl.Caption
If StrComp(sideLetter, "Random") = 0 Then
Randomize
tempRand = Int((Rnd() * 2 + 1))
If tempRand = 1 Then
sideLetter = "X"
Else
sideLetter = "O"
End If
End If
End Sub
The Line sideLetter = Side.ActiveControl.Caption Is the one causing the issue. I have not explicitly declared Side as a frame control in case that's some helpful information because I'm thinking that the object is already declared just by making the Frame Control. Thanks in advance!
You need to check that Side.ActiveControl is actually an object, before you read it's Caption:
Public Sub Side_Click()
If Not Side.ActiveControl Is Nothing Then
sideLetter = Side.ActiveControl.Caption
If StrComp(sideLetter, "Random") = 0 Then
Randomize
tempRand = Int((Rnd() * 2 + 1))
If tempRand = 1 Then
sideLetter = "X"
Else
sideLetter = "O"
End If
End If
End If
End Sub
I have written a macro to take values from an external simulation tool and prints the results in excel.The simulaion tool will give values only every 30 seconds and will run for days. Hence i have given a delay in VB for 30 seconds in loop. I leave it overnight for running. In the next morning i could see none of the results were updated after certain rows.But the VBA editor header shows the macro is running and the external simulation tool is also running. The last updated row in excel is not constant everytime. Why does VBA stops printing the results in excel? Any help will be much appreciated.
Sample code:
For l = 3 To lastrow1_mul + 2
Module4.Wait 30
nv = send_data.Call
Sheets(SecondSheetName).Range(SecondSheetCol_9 & l) = Hex(nv)
dv = DT.Call
If dv = 44 Then
Sheets(SecondSheetName).Range(SecondSheetCol_10 & l) = "A"
ElseIf dv = 54 Then
Sheets(SecondSheetName).Range(SecondSheetCol_10 & l) = "B"
Else
Sheets(SecondSheetName).Range(SecondSheetCol_10 & l) = "C"
End If
Next l
Module 4:
Function Wait(PauseTime As Single)
Dim StartTime As Single
StartTime = Timer
While Timer < StartTime + PauseTime
DoEvents
Wend
End Function
Send_data and DT are external simulation tool's functions.Variable lastrow1_mul's value is getting updated around 7000 but rows in excel stops printing around 500 itself(not constant always) .
looks OK but look at using Application.OnTime shown below. Also what happens if the simulation hasnt returned data, shoudnt you build in a bigger, maybe 45 second intervals?
Application.OnTime Now + TimeValue("00:00:30"), "RunProcess"
The 'Timer' i used in the code was the culprit. Timer counts the seconds elapsed(in fractions) since midnight. So it will not update when the time becomes 00.00.00. So the wait function i wrote will keep on waiting!
Here is the solution
Function Wait()
Dim StartSecond As Single
Dim EndSecond
StartSecond = Now
EndSecond = DateAdd("s", 30, Now)
While Now < EndSecond
DoEvents
Wend
End Function