I added a trendline and get its linear equation value as y = ax + b form. In excel VBA how can I get constant a from this formula?
In formulas
The following equations assume that your sheet has two named ranges: x and y. Then:
a = SLOPE(y,x)
b = INTERCEPT(y,x)
Source: Chart Trendline Formulas
Without named ranges, you use for example:
a = SLOPE(B2:B22, A2:A22)
b = INTERCEPT(B2:B22, A2:A22)
In VBA
rangeX = Range(Cells(2, 1), Cells(22, 1))) ' OR: rangeX = Range("A2:A22")
rangeY = Range(Cells(2, 2), Cells(22, 2))) ' OR: rangeY = Range("B2:B22")
a = Application.WorksheetFunction.Slope(rangeY, rangeX)
b = Application.WorksheetFunction.Intercept(rangeY, rangeX)
you can read the actual formula by turning on the label
then read the label itself and parse it
Sub readFormula()
Dim ttt As Trendline
Set ttt = ActiveChart.FullSeriesCollection(1).Trendlines(1)
ttt.DisplayEquation = True
Debug.Print ttt.DataLabel.Caption
Debug.Print ttt.DataLabel.Formula
Debug.Print ttt.DataLabel.FormulaLocal
Debug.Print ttt.DataLabel.FormulaR1C1
Debug.Print ttt.DataLabel.FormulaR1C1Local
Debug.Print ttt.DataLabel.Text
ttt.DisplayEquation = False
end sub
Related
I have Location data (latitude and longitude) of 1000's of locations and need to compute the distance between each of them taken two combinations at a time.
Example:
Let's just say I have four location data (latitude and longitude data) and want to compute the distance between them
Location Latitude Longitude
1. New York(L1) 40.7128° N 74.0060° W
2. Paris(L2) 48.8566° N 2.3522° E
3. London(L3) 51.5074° N 0.1278° W
4. Moscow(L4) 55.7558° N 37.6173° E
Need to calculate the distance between possible combinations i.e distance between L1&L2, L1&L3, L1&L4, L2&L3, L2&L4 and L3&L4
Excel Formula I'm using to compute distance is
=ACOS(COS(RADIANS(90-Lat1)) *COS(RADIANS(90-Lat2)) +SIN(RADIANS(90-Lat1)) *SIN(RADIANS(90-Lat2)) *COS(RADIANS(Long1-Long2))) *6371
How can I calculate it for large data set say 100's or 1000's of locations?
Alternatively, you can create a VBA function and then loop through your table.
Add this code to a Module in the VBA editor:
Public Function DistBetweenCoord(Lat1 As Double, Long1 As Double, Lat2 As Double, Long2 As Double)
'Cell Formula
'ACOS(COS(RADIANS(90-Lat1)) *COS(RADIANS(90-Lat2)) +SIN(RADIANS(90-Lat1)) *SIN(RADIANS(90-Lat2)) *COS(RADIANS(Long1-Long2))) *6371
With WorksheetFunction
A = Cos(.Radians(90 - Lat1))
B = Cos(.Radians(90 - Lat2))
C = Sin(.Radians(90 - Lat1))
D = Sin(.Radians(90 - Lat2))
E = Cos(.Radians(Long1 - Long2))
DistBetweenCoord = .Acos(A * B + C * D * E) * 6371
End With
End Function
Now you can access this through code or in cell. Here is an example of in-cell:
=DistBetweenCoord(C1,D1,C2,D2)
Here is how to loop through all possible combinations in another Sub. Output is in immediate window.
Sub CalcAllDistances()
With Worksheets("Sheet1")
For i = 1 To 4
For j = i To 4
If i <> j Then
Debug.Print .Cells(i, 2) & " to " & .Cells(j, 2) & ": " & DistBetweenCoord(.Cells(i, 3), .Cells(i, 4), .Cells(j, 3), .Cells(j, 4))
End If
Next j
Next i
End With
End Sub
EDIT - To change output to Sheet2 try the following:
Sub CalcAllDistances()
Dim wks_Output As Worksheet
Set wks_Output = Worksheets("Sheet2")
Dim OutputRow As Long: OutputRow = 1
With Worksheets("Sheet1")
For i = 1 To 4
For j = i To 4
If i <> j Then
wks_Output.Cells(OutputRow, 1).Value = .Cells(i, 2) & " to " & .Cells(j, 2)
wks_Output.Cells(OutputRow, 2).Value = DistBetweenCoord(.Cells(i, 3), .Cells(i, 4), .Cells(j, 3), .Cells(j, 4))
OutputRow = OutputRow + 1
End If
Next j
Next i
End With
End Sub
I would use a matrix.
Create a sheet (like 'GeocodeList' or something) for the geocodes, like your city|lat|lon in the question. Then create a sheet (like 'Distances') for a matrix, where the column and row labels are the city names. Then you can parameter your excel formula using V.LOOKUPs that look up exact codes from GeocodeList.
The formula would look like this (X is row number, Y is column letter.):
=ACOS(COS(RADIANS(90-VLOOKUP($A(X); GEOCODETABLE, LATCOLINDEX, 0)))
*COS(RADIANS(90-VLOOKUP((Y)$1; GEOCODETABLE; LATCOLINDEX, 0)))
+SIN(RADIANS(90-VLOOKUP($A(X); GEOCODETABLE, LATCOLINDEX, 0)))
*SIN(RADIANS(90-VLOOKUP((Y)$1; GEOCODETABLE; LATCOLINDEX, 0)))
*COS(RADIANS(VLOOKUP($A(X); GEOCODETABLE, LATCOLINDEX, 0)-VLOOKUP((Y)$1; GEOCODETABLE; LONCOLINDEX, 0))))
*6371
So basically the VLOOKUP automatically fetches your parameters, and you can extend the formula for the whole matrix.
I want a formula for column E3 depend on column A3,B3,C3 and D3. If multiple columns show yes or single column show yes I want show as below in pink. Need to combine shctin names which show "yes".Formula required for column E .End result shoul show as pink color.
Check it out
Sub Button1_Click()
Dim x, y, z
For x = 3 To 15
For y = 1 To 4
If UCase(Cells(x, y)) = "YES" Then
z = z & "_" & Cells(2, y)
End If
Next y
Cells(x, 5) = Right(z, Len(z) - 1)
z = ""
Next x
End Sub
User Defined Function,the function code belongs in a regular module.
Place this formula in E3 and drag down,
=Get_It(A3:D3,2)
Function Get_It(a As Range, Return_Row As String)
Dim c As Range
Dim s As String
For Each c In a.Cells
If UCase(c) = "YES" Then
s = s & "_" & Cells(Return_Row, c.Column)
End If
Next c
Get_It = Right(s, Len(s) - 1)
End Function
There's another way using formulas. A little ugly but ok as a non-VBA alternative.
I've got a macro that works perfectly but that I now need to customize it and add complexity.
The macro is basically the following code repeated numerous times for a variety of ranges.
For i = 2 To n
Range(Cells(13, i), Cells(19, i)).Value = Sheets(i).Range("J13:J19").Value
Next i
The logic/complexity that I need to add to this should go as follows:
if the sum of the range O13:O19 on sheet i is greater than zero, then the value of the range cells(13,i),cells 19,i) on this sheet are equal to the value of the range p13:p19 on sheet i.
If the value of the sum of range O13:O19 on sheet i is not greater than 0, then set the value of the target range equal to each cell in (range sheet(i).range("I13:I19")-sheet(i).range("K13:K19")*4).value
In simpler terms, if the sum of the range is 0, set the value of every cell in range A to the value of every cell in range b less the (value of every cell in range C * 4)...
Sub Op_ex_analysis_macro()
ActiveWorkbook.Sheets.Add Before:=Worksheets(1)
ActiveSheet.Name = "Control Panel"
Range("A:A").ColumnWidth = 36
Range("A12").Value = "Property Code"
Range("A13:A16") = Sheets(2).Range("A13:A16").Value
Range("A17") = Sheets(2).Range("B17").Value
Range("A18") = Sheets(2).Range("A18").Value
Range("A19") = Sheets(2).Range("B19").Value
Range("A20:A29") = Sheets(2).Range("A21:A30").Value
Range("A30") = Sheets(2).Range("B31").Value
Range("A31") = Sheets(2).Range("A33").Value
Range("A32:A36") = Sheets(2).Range("A35:A39").Value
Range("A37:A38") = Sheets(2).Range("A41:A42").Value
Range("A40").Value = "Analyst"
Range("A41").Value = "Number of Units"
Range("A42").Value = "Asset Manager"
Range("A43").Value = "Tenancy"
Range("A44").Value = "Year Built/Type"
Range("A45").Value = "Management Company"
Range("A46").Value = "End of Compliance Year"
Range("A47").Value = "Property Name"
Range("A48").Value = "Number of Properties"
Range("A49").Value = "City"
Range("A50").Value = "State"
'Consolidate Property Codes
n = ActiveWorkbook.Sheets.Count
For i = 2 To n
Z = Sheets(i).Range("P49").Value
Cells(12, i) = Z
Next i
'Consolidate rows 13-19
For i = 2 To n
Select Case Application.Sum(ThisWorkbook.Sheets(i).Range("O13:O33"))
Case Is > 0
Range(Cells(13, i), Cells(19, i)).Value = Sheets(i).Range("P13:P19").Value
Case Is = 0
Range(Cells(13, i), Cells(19, i)).Value = ThisWorkbook.Sheets(i).Range("I13:I19") - ThisWorkbook.Sheets(i).Range("K13:K19") * 4
End Select
Next i
In this case i think the best option is to use a Select case statement.
For i = 2 To n
Select Case Application.Sum(ThisWorkbook.Sheets(i).Range("O13:O33"))
Case Is > 0
Range(Cells(13, i), Cells(19, i)).Value = Sheets(i).Range("P13:P19").Value
Case Is < 0
Range(Cells(13, i), Cells(19, i)).Value = ThisWorkbook.Sheets(i).Range("I13:I19") - ThisWorkbook.Sheets(i).Range("K13:K19") * 4
End Select
Next i
Hope this helps :)
EDIT If ou want to account for whent it's "0" then just add a Case Is 0
After a lot of trial and error, I was able to solve the problem through via a different route.
As A.S.H correctly noted above, you can't do arithmetic on VBA arrays.
The first half of my code was basically moving an array, as Scott Craner noted on a different page, which is simple.
Directing VBA to perform calculations requires the coder to send the formula through a range cell by cell.
Ultimately, the code that performed as required was as follows:
Dim rng As Range
n = ActiveWorkbook.Sheets.Count
With ActiveSheet
For i = 2 To n
If Application.Sum(Sheets(i).Range("O13:O33")) > 0 Then
.Range(.Cells(13, i), .Cells(19, i)).Value = Sheets(i).Range("P13:P19").Value
Else
For Each rng In .Range(.Cells(13, i), .Cells(19, i))
rng.Value = Sheets(i).Cells(rng.Row, "I") - (4 * Sheets(i).Cells(rng.Row, "K"))
Next rng
End If
Next i
End With
If the condition of the first 1/2 of the if statement is met, then it's just set these values equal to those values. If the condition is not met, then the Else statement directs Excel to move through the range performing the calculation as it goes.
I am trying to write a similar function in VBA:
=VLOOKUP(“EN878”,CHOOSE({1,2},A2:B5,D2:E5),2,False)
In particular, What is the correct way of using the {} character in VBA?
Every time I try, I get "Compile error: Invalid Character"
My code:
Variables
Table3 = Workbooks("gangstar.xlsx").Worksheets("60 in August 2016-26082016-1137").Range("A1:A1000")
Table2 = Workbooks("gangstar.xlsx").Worksheets("60 in August 2016-26082016-1137").Range("H1:H1000")
For Each cl In Table1
Sheet1.Cells(Dept_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(cl, Choose({1,2}, Table2, Table3), 2, False)
Dept_Row = Dept_Row + 1
Next cl
I am able to use the VLOOKUP with CHOOSE fine in the Excel spreadsheet.
Try the following, which doesn't require modification or recalculation of any cells on the Worksheet:
WorksheetFunction.VLookup("EN878", WorksheetFunction.Choose(Array(1, 2), Range("A2:B5"), Range("D2:E5")), 2, False)
If you are trying to decide which table to use as Vlookup array you can use IIf function.
Like:
Application.WorksheetFunction.VLookup(cl, IIf(cl.column=1, Table2, Table3), 2, False)
I would recommend using Sheet1.Cells(myRow, myCol).Formula = "=VLOOKUP(...)" followed by Sheet1.Cells(myRow, myCol).Calculate.
Not an answer but what the OP is doing is not as simple as it appears.
Given this data:
And this code:
Sub Tester()
Dim r
r = Application.Evaluate("CHOOSE({1,2},A1:B5,E1:F5)")
Dumper r
End Sub
Sub Dumper(arr)
Dim r, c, s, v
For r = 1 To UBound(arr, 1)
s = ""
For c = 1 To UBound(arr, 2)
v = arr(r, c)
s = s & vbTab & IIf(IsError(v), "Err!", v)
Next c
Debug.Print s
Next r
End Sub
Here's the output:
A1 F1
A2 F2
A3 F3
A4 F4
A5 F5
Is that what you'd expect ?
I would use range.formulaR1C1 property.
Table3AddressR1C1 = Workbooks("gangstar.xlsx").Worksheets("60 in August 2016-26082016-1137").Range("A1:A1000").address(,,xlR1C1, true)
Table2AddressR1C1 = Workbooks("gangstar.xlsx").Worksheets("60 in August 2016-26082016-1137").Range("H1:H1000").address(,,xlR1C1, true)
Sheet1.Range(Cells(1, Dept_Clm), Cells(Table1.rows.count, Dept_Clm)).FormulaR1C1 = "=VLookup(RxCx, Choose({1,2}, Table2AddressR1C1, Table3AddressR1C1), 2, False)"
I have an Excel document with some plain text in a row. The cells in the range A1:A5 contain texts, then a hundred of rows down there's another few rows with text. Cells between are empty.
I've set up a Do Until loop which is supposed to copy cells with text, and then stop when an empty cell appears. My loop counts and copies 136 cells including the 5 with text.
So my question is why?
The bottom line: Hello ends up on line 136, and then there's a huge gap of empty cells until next area with text. Do the 131 white cells contain any hidden formatting causing this?
I've tried "Clear Formats" and "Clear All". I've also tried using vbNullString instead of " ".
Code snippet:
Sub CopyTags_Click()
Dim assets As Workbook, test As Workbook
Dim x As Integer, y As Integer
Set assets = Workbooks.Open("file-path.xlsx")
Set test = Workbooks.Open("File-path.xlsx")
x = 1
y = 1
Do Until assets.Worksheets(1).Range("A" & x) = ""
test.Worksheets(1).Range("A" & y) = assets.Worksheets(1).Range("A" & x)
x = x + 1
y = y + 1
Loop
test.Worksheets(1).Range("A" & x).Value = "Hello"
End Sub
Use a For Next Statement terminating in the last used cell in column A. Only increment y if there has been a value found and transferred and let the For ... Next increment x.
Sub CopyTags_Click()
Dim assets As Workbook, test As Workbook
Dim x As Long, y As Long
Set assets = Workbooks.Open("file-path.xlsx")
Set test = Workbooks.Open("File-path.xlsx")
x = 1
y = 1
with assets.Worksheets(1)
for x = 1 to .cells(rows.count, 1).end(xlup).row
if cbool(len(.Range("A" & x).value2)) then
test.Worksheets(1).Range("A" & y) = assets.Worksheets(1).Range("A" & x)
y = y + 1
end if
next x
test.Worksheets(1).Range("A" & y).Value = "Hello"
end with
End Sub