GrADS Code Error - grads

I am having trouble with this code in GrADS. The error kept saying that my two if statements were invalid. I reinstated some stars but it gave me a whole new error.
"open NAM12Z0709.ctl"
"set display color white"
"clear"
"set mpdset hires"
"set grad off"
"set lev 1000"
'run rgbset.gs'
'set lat 36 38'
'set lon -125 -120'
'define lcl=((TMPsfc-DPT2m)*400)'
'define tc=(TMPprs-273.15)'
'define es=(6.11*exp((17.625*tc)/(tc+243.05)))'
'define e=(es*RHprs/100)'
'define wr=(622*e/(925-e))'
'define expo=(exp((2257*wr)/(1004*TMPprs)))'
'define numer=(-2.06327*TMPprs/(6516))'
'define denom=(pow((RHprs/100),0.46))'
'define thetae=(expo*numer/denom)'
'define b=((-6.67*thetae-0.667)*(-0.1*VVELprs))'
if (HGTprs <= lcl)
'b=0'
endif
if (VVELprs >= 0)
'b=0'
endif
'set clevs 0.0 0.125 0.25 0.375 0.5 0.625 0.75 0.875 1.0'
'set ccols 1 4 13 3 10 7 12 8 2'
'set gxout shaded'
'set grads off'
'd b'
"printim testing12Zcloud.png png"
'clear'
'quit'

You are confusing between Grads's variable/field and Grads Script's variable.
Specificlly, you cannot use HGTprs and VVELprs as a Grads script variable like that.

Related

Multiple charts by groups in column VBA

m completely new to vba programming and I was unable to find similar questions. Please guide me in the right direction if the answer to a similar problem is already to be found in this forum.
I have the following dataset (in practice, the dataset contains more names and dates per name):
Name Date Value1 Value2
AA 01-02-2022 0.5744 10
AA 01-03-2022 0.5542 10
AA 01-04-2022 0.5551 10
AA 01-05-2022 0.5678 10
BB 01-02-2022 0.5518 11
BB 01-03-2022 0.5659 11
BB 01-04-2022 0.5455 11
BB 01-05-2022 0.5404 11
CC 01-02-2022 0.5524 12
CC 01-03-2022 0.5321 12
CC 01-04-2022 0.5554 12
CC 01-05-2022 0.5407 12
I want to create multiple charts using VBA - separate charts for each name in column "Name" i.e. one chart for AA, another chart for BB and a third chart for CC etc.VBA The charts should plot Value1 and Value2 on the Y-axis against Date on the X-axis.
The data is loaded into the spreadsheet using a power query, which extracts data from an Oracle database.
If possible, I would like to place the charts next and/or appended to each other.
As (new) names are regularly removed (added) to the dataset, I am looking for a dynamic solution and hope to solve this using VBA.
Please do not hesitate to comment if I need be more clear in my description or to elaborate.
Kind regards,
Please, try the next code. It uses a dictionary to keep the unique names as key and range first row, respectively, last row as items. Then builds DataSource based on them:
Sub TestInsertCClusteredChart()
Dim sh As Worksheet, lastR As Long, arr, arrIt, i As Long, dict As Object
Dim rngDS As Range, ch_shape As Shape, chLeft As Double, chTop As Double
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
arr = sh.Range("A1:A" & lastR).Value2
Set dict = CreateObject("Scripting.Dictionary")
'dict.RemoveAll
For i = 2 To UBound(arr)
If Not dict.Exists(arr(i, 1)) Then
dict.Add arr(i, 1), Array(i)
Else
arrIt = dict(arr(i, 1))
If UBound(arrIt) = 0 Then
ReDim Preserve arrIt(1)
arrIt(1) = i
Else
arrIt(1) = i
End If
dict(arr(i, 1)) = arrIt
End If
Next i
chLeft = sh.Range("F2").left: chTop = sh.Range("F2").top 'positions of the first chart
'build dataSource range and insert chart:
For i = 0 To dict.count - 1
Set rngDS = Union(sh.Range("A1:D1"), sh.Range(sh.cells(dict.Items()(i)(0), "A"), sh.cells(dict.Items()(i)(1), "D")))
Set ch_shape = sh.Shapes.AddChart2 'insert the chart
With ch_shape.Chart
With .ChartArea
.left = chLeft
.top = chTop
End With
.ChartType = xlColumnClustered
.SetSourceData rngDS
chLeft = chLeft + .ChartArea.width 'calculate the left position for the next chart
End With
Next i
End Sub
Sub deleteCharts(sh As Worksheet)
Dim s As Shape
For Each s In sh.Shapes
If s.HasChart Then s.Delete
Next
End Sub
Please, send some feedback after testing it.
The chart is created using default dimensions (height, width). They can be set, of course.
Adapted the code according to your recent requirements.

How to recursively parse data out of an e-mail using VBA?

So I get e-mails every day with information in them. Unfortunately, for some reason, the data is sent in the body of the e-mail, and not as an attachment. Fine then. I'm using Excel to scrape Outlook, using VBA.
Sub mytry()
Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim str As String
Dim TextWeNeedToParse as String
Const num As Integer = 6
Const path As String = "C:\HP\"
Const emailpath As String = "C:\Dell\"
Const olFolderInbox As Integer = 6
Set olp = CreateObject("outlook.application")
Set olmapi = olp.getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)
If olmail.items.restrict("[ReceivedTime]>=""&MacroDate&12:00am&""").Count = 0 Then
Else
For Each olitem In olmail.items.restrict("[ReceivedTime]>=""&MacroDate&12:00am&""")
TextWeNeedToParse = olitem.body
'Recursive text parsing here
Next olitem
End If
Ok, so this code snippet should get me the entire body of the text into a string. Now we can pass the string around, and manipulate it.
A sample of the text I'm dealing with:
WAL +300bp QTY
(M) FCTR SECURITY CPN ASK 1mPSA TYPE
0.77 1.15 458 0.04 GNR 2012-61 CA 2.00 99-16 217 SEQ
1.39 2.26 120 0.76 GNR 2005-13 AE 5.00 102-24 223 SUP
1.40 18.16 45 0.65 GNR 2015-157 NH 2.50 95-16 215 EXCH,+
1.50 21.56 25 0.94 GNR 2017-103 HD 3.00 98-08 375 PAC-2
So there are a few different ways I can see myself tackling this, but I don't quite know all of the pieces.
1) I could try counting how many carriage returns exist, and doing a loop. Then "counting" spaces to figure out where everything is. Not quite sure how well it would work.
2) I could regex out the unique ID in the middle, and if I can figure out how to regex the nth instance (a major point where I'm stuck), I could also use that to regex out the numbers - for example, line one would be the 1-5 instance of straight numbers/decimals together surrounded by spaces, and the first instance of number-number-dash-number-number.
Sample Regex Code that I'd throw through it:
Function regex(strInput As String, matchPattern As String, Optional ByVal outputPattern As String = "$0") As Variant
Dim inputRegexObj As New VBScript_RegExp_55.RegExp, outputRegexObj As New VBScript_RegExp_55.RegExp, outReplaceRegexObj As New VBScript_RegExp_55.RegExp
Dim inputMatches As Object, replaceMatches As Object, replaceMatch As Object
Dim replaceNumber As Integer
With inputRegexObj
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = matchPattern
End With
With outputRegexObj
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "\$(\d+)"
End With
With outReplaceRegexObj
.Global = True
.MultiLine = True
.IgnoreCase = False
End With
Set inputMatches = inputRegexObj.Execute(strInput)
If inputMatches.Count = 0 Then
regex = False
Else
Set replaceMatches = outputRegexObj.Execute(outputPattern)
For Each replaceMatch In replaceMatches
replaceNumber = replaceMatch.SubMatches(0)
outReplaceRegexObj.Pattern = "\$" & replaceNumber
If replaceNumber = 0 Then
outputPattern = outReplaceRegexObj.Replace(outputPattern, inputMatches(0).Value)
Else
If replaceNumber > inputMatches(0).SubMatches.Count Then
'regex = "A to high $ tag found. Largest allowed is $" & inputMatches(0).SubMatches.Count & "."
regex = CVErr(xlErrValue)
Exit Function
Else
outputPattern = outReplaceRegexObj.Replace(outputPattern, inputMatches(0).SubMatches(replaceNumber - 1))
End If
End If
Next
regex = outputPattern
End If
End Function
3) I could try some of the methods above, but use recursion. My recursion is fairly weak.
So once I have the text string extracted, I imagine I'd need something like:
Sub QuickExample(Dim Cusip as String, Dim PriceStr as variant, Dim SpreadStr as variant)
Dim ws as WorkSheet
Set ws = thisworkbook.sheets("Results")
LastRow = ws.Cells(sht.Rows.Count, "A").End(xlUp).Row
ws.cells(Lastrow,1).value2 = Cusip
ws.cells(Lastrow,2).value2 = PriceStr
ws.cells(Lastrow,3).value2 = SpreadStr
End Sub
And lastly:
Sub ParsingDate(EmailText as String)
Dim CarriageReturns As Long
CarriageReturns = Len(EmailText) - Len(Replace(EmailText, Chr(10), ""))
For i = 1 to CarriageReturns
'Parse out the data for the ith row, return it to the function above
Next i
End Sub
It's the actual act of parsing which I'm struggling a bit with - how do I properly get the nth result, and only the nth result? How do I make sure it keeps working even if some extra spaces or lines get added? Is there a way to just use regex, and "look" around the nth finding of a given expression? Is it doable to make this without a lot of recursion?
Thank you
WAL +300bp QTY
(M) FCTR SECURITY CPN ASK 1mPSA TYPE
0.77 1.15 458 0.04 GNR 2012-61 CA 2.00 99-16 217 SEQ
1.39 2.26 120 0.76 GNR 2005-13 AE 5.00 102-24 223 SUP
1.40 18.16 45 0.65 GNR 2015-157 NH 2.50 95-16 215 EXCH,+
1.50 21.56 25 0.94 GNR 2017-103 HD 3.00 98-08 375 PAC-2
This seems like a pretty well formatted table. Perhaps pop each line into an array using Split() and then each field into an array, again using split():
Sub dump()
arrLine = Split(TextWeNeedToParse, Chr(10))
For Each Line In arrLine
For Each field In Split(Line, " ")
Debug.Print field
Next
Next
End Sub
That's super short and runs quick. You are just an if statement and counter (or regex test) away from getting the exact items you want.
Testing/counting may be easier if you remove multiple spaces so the split() puts each element in it's proper place. You could employee a loop to remove multiple spaces before running this:
Fully implemented it might be something like:
<your code to get the bod>
'remove multiple spaces from string for parsing
Do While InStr(1, TextWeNeedToParse, " ")
TextWeNeedToParse= Replace(TextWeNeedToParse, " ", " ")
Loop
'Get each line into an array element
arrLine = Split(TextWeNeedToParse, Chr(10))
'Loop through the array
For Each Line In arrLine
'dump fields to an array
arrFields = Split(Line, " ")
'and spit out a particular element (your "unique id" is element 5)
If UBound(arrFields) >= 5 Then Debug.Print "unique id:"; arrFields(5)
Next

VBA creation of a Matrix and double loop

I have a lot of Excel files in one folder and for each one I have (H:H) which contains a certain hour from 00:00 to 23:59 (appears within H at the format 0000 or 2359 etc ..) .
Then, at a certain hour we associate a certain number of operation (contains by column A) in the same sheet, but the time is not "homogeneous" , for example we can have 0012 at H4 on sheet 1 and 0014 in H4 on sheet number 2, meaning that time is not divided the same way according each sheet.
Sheet 1 Sheet 2
0010 ;0004
0017 ;0014
0018 ;0023
0025, ;0045
0025 ;0057
0031
0035
0055
I am trying to create a matrix with VBA on another sheet which would sum the number of operation only for a time-slot, I wish basically 00:15 to 00:59 , 01:00 to 01:59 ... and fill the matrix with the number of operation present in column A which correspond at the number of operation for the period of time (the hour) for each excel sheet of my folder.
The matrix I am trying to make would have the following form:
0000-0059 (H1) 0100-0159 (H2) 0200-0259 (H3) 0300-0359 (H4)...... 2300:2359(H24)
1
2
3
4
.
.
till, "number of files in my folder"
I had the idea to do something like it, but I realized the problem is not that simple ...
Sub Dailytraffic()
Application.ScreenUpdating = False
Dim wB As Workbook
Dim SumResult As Double
Dim H1, H2, H3, H4, H5, H6, H7, H8, H9, H10, H11, H12, H13, H14, H15, H16, H17, H18, H19, H20, H21, H22, H23, H24 As Double
Dim OutPutRange As Range
Set FileSystemObj = CreateObject("Scripting.FileSystemObject")
Set FolderObj = FileSystemObj.GetFolder("C:\...\")
Set OutPutRange = Workbooks("Libro1").Sheets("Hoja1").Range("D4")
Set H1RAN = Workbooks("Libro1").Sheets("Hoja1").Range("B1")
Set H2RAN = Workbooks("Libro1").Sheets("Hoja1").Range("C1")
Set H3RAN = Workbooks("Libro1").Sheets("Hoja1").Range("D1")
.
.
.
Set H24RAN = Workbooks("Libro1").Sheets("Hoja1").Range("AA1")
Set wB = Workbooks.Open(fileobj.Path)
For Each fileobj In FolderObj.Files
Dim i As Long
For i = 1 To 300
If (0 <= Left(wB.Sheets("Schedule Daily Bank Structure R").Cells(8, 4 + i).Value, 2) < 1) Then
H1 = WorksheetFunction.Sum(wB.Sheets("Schedule Daily Bank Structure R").Cells(1, i))
H1RAN.Value = H1
Set H1RAN = H1RAN.Offset(1, 0)
For j = 1 To 300
If (1 <= Left(wB.Sheets("Schedule Daily Bank Structure R").Cells(8, 4 + j).Value, 2) < 2) Then
H2 = WorksheetFunction.Sum(wB.Sheets("Schedule Daily Bank Structure R").Cells(1, i))
H2RAN.Value = H2
Set H2RAN = H2RAN.Offset(1, 0)
End If
Next i
Next j
wB.Save
wB.Close
Next fileobj
End Sub
My Idea would be to repeat 24-2 times more, but it does not seem to work. I have trouble to mix the loop which manages to sum for each different period of time and the Loop which go through the different files ... I am blocked here.

Comparing Snapshot Data in Excel (VBA?) [duplicate]

I have this worksheet which gets data from API and its refreshes itself every 200 milliseconds. I want to calculate the change in value which is constantly increasing every 200 ms. For example Cell B2 has a value of 4 after 200 ms its changes to 7 then to 16 then to 26 etc, it just keeps adding value into it. All I want is to subtract the old value from the latest value to get the change for example 7-4=3 or 16-7=9 or 26-16=10.
I have added an image for clarification. This shows how I'm getting a data from software.
And one more image:
First, enable Iterative Calculations in Excel by going to File -> Options -> Formulas and then checking the box next to "Enable iterative calculation".
You need to define the following cells:
cell B1 0 (set to 1 to reset)
cell B2 =IF($B$1 = 1,, $B$2 + 1)
Use the following formula and fill down from B9 for as many changes as you would like to see (This formula assumes you have maximum iterations set to 100):
cell B9 =IF($B$1 = 1,"", IF($B$2 / 100 = $A9, $B$5, B9))
I will try to show an example here. If your cell that automatically updates is B5, then the changes will be tracked in B9 and below as the cell is refreshed. It may not be exactly what you are looking for, but I think it is close.
A B
1 reset 0
2 count 500
3
4
5 price 9
6
7
8 ID price
9 1 11
10 2 12
11 3 13
12 4 12
13 5 9
I suggest VBA solution, based on worksheet change event handling. Open VBA Project and put the below code into the target worksheet in Microsoft Excel Objects section:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' add reference to Microsoft Scripting Runtime via Menu - Tools - References
Const Scope = "C2:C5" ' monitoring area
Const DX = 1 ' horizontal result offset
Const DY = 0 ' vertical result offset
Const Buf = 0 ' FIFO buffer size
Static oData(0 To Buf) As New Dictionary
Static oIndex As New Dictionary
Dim rCells As Range
Dim oCell
Dim i As Long
Set rCells = Application.Intersect(Target, Target.Parent.Range(Scope))
If Not rCells Is Nothing Then
For Each oCell In rCells
With oCell
i = oIndex(.Address)
.Offset(DY, DX).Value = .Value - oData(i)(.Address)
oData(i)(.Address) = .Value
i = i + 1
If i > Buf Then i = 0
oIndex(.Address) = i
End With
Next
End If
End Sub
I added some comments for constants. Set the range which change to be monitored in Scope, the offsets where the resulting delta will be output in DX and DY, and as a bonus that algorithm supports computing delta not only between last and previous numbers, but also between any number of frames for each target cell via buffer organized as array of dictionaries, so set the size of the buffer in Buf, if you do not want to use the buffer then just leave 0 size, e. g. the value of 3 will compute delta between the last value and the one delayed by 800 ms for your case.
UPDATE
There is slightly simplified version of the code as requested in comment, put the below code into the target worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Const Scope = "C2:C5" ' monitoring area
Static oData As New Dictionary
Dim rCells As Range
Dim oCell
Dim dDelta
Set rCells = Application.Intersect(Target, Target.Parent.Range(Scope))
If Not rCells Is Nothing Then
For Each oCell In rCells
With oCell
dDelta = .Value - oData(.Address)
If dDelta <> 0 Then
.Offset(0, 1).Value = dDelta
oData(.Address) = .Value
End If
End With
Next
End If
End Sub

VBA Excel Graphing Add time to X-Axis

I am graphing a trend for a pump for a day, I am getting a sample data every minuet
I got the graph all working but the problem I am running into is trying to get the time on the X-axis. There is a column that shows the time each sample data was taken, but when I tried to add it, it put the time for every point in the chart. Because I have 1440 points in the chart, it was just a blob of unreadable text, I removed that code and right now I am doing without. But I would like to figure it out.
'Chart for Monday
With wBM.ActiveSheet.ChartObjects.Add(Left:=300, Width:=300, Top:=10, Height:=300)
.Chart.SetSourceData Source:=wBM.ActiveSheet.Range("B1:B1440"), PlotBy:=xlColumns
.Chart.ChartType = xlLine
.Left = rngChart2.Left
.Top = rngChart2.Top
.Width = rngChart2.Width
.Height = rngChart2.Height
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "Monday " & Monday
.Chart.HasLegend = False
End With
This is my code so far. In Column D has the time for each point so it would be "D1:D1440".
Is there a way to only have 1 label for every 60 points, or 120? So that I don't have such a blob of labels?
Starting with sample data that looks like this:
I ran this macro to hide all labels which 'location' is not multiple of 5
Sub formateDataLabels()
Dim chrt As Chart
Set chrt = ActiveChart
Dim cnt As Long: cnt = 1
For Each lbl In chrt.SeriesCollection(1).DataLabels
If cnt Mod 5 <> 0 Then
lbl.Text = ""
End If
cnt = cnt + 1
Next lbl
End Sub
Result:
Note that the current code is simply set up to run on the selected chart. Change the 5 to whatever you need such as 50 or 100 and adapt to your current chart.