I am trying to construct a 2x2 matrix dependent on values in some cells (say B1). The code shall take the reference and make some mathematical manipulations, then assign this value to a new cell.
Sub matrix2()
Dim matrix(1 To 2, 1 To 2) As String
k1 = Cells(1, 2).Value
For i = 1 To 2
For j = 1 To 2
k = (-1) ^ (i + j)
matrix(i, j) = "=B1*" & k
Next j
Next i
Range("D1:E2") = matrix
End Sub
In the end, I get what I want but I need to go to each cell and press Enter to convert them in a real value. What I should get here is a matrix dependent on the value in B1. When I change B1, the values in the matrix will automatically change.
Is there any way to make it happen more easily? Because, I will be dealing with 40x40 matrices in the end, and I don't want to go over 1600 cells and press Enter.
I doubt this is going to be helpfull right now, but maybe in the (near) future. With the new MAKEARRAY() function you could do this outside of VBA with relative ease:
Formula in D3:
=MAKEARRAY(2,2,LAMBDA(i,j,B1*(-1^(i+j))))
You have to use a variant-array - not a string-array
Try this:
Sub Matrix2()
Dim arr(1 To 2, 1 To 2) as Variant 'instead of String
k1 = Cells(1, 2).Value
For i = 1 To 2
For j = 1 To 2
k = (-1) ^ (i + j)
arr(i, j) = "=B1*" & k
Next
Next
ActiveSheet.Cells(8, 1).Resize(2, 2).Formula = arr
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.
In Excel, I have many products with different sizes listed in columns, such that the sizes "10x10 cm", "11x11 cm" and "15x15 cm" belongs to Product A, etc.
In some other cells, I am selecting a product (either Product A, Product B, or Product C) and a size.
I want, for each of the other products, to determine which size is closest to the selected product:
I don't know how to solve this. One solution might be to remove all non-numeric characters from the strings and add the two values on each side of the "x" and then select the size with the lowest absolute difference from the sum of the selected size.
But I guess it would be easier to do a mapping and use a VLOOKUP to choose the first found size in a given column.
However, the problem is that I do not only have 3 products with a few different sizes, but rather 15 different products with 10 different sizes, so I don't know how to do a mapping in a clever way.
1) Creating a lookup table with the values extracted for each product,
Source sheet:
Code:
Sub lookup()
Dim i As Long, j As Long, prod As Integer, str As String
prod = InputBox("Enter Number of Products")
Sheets.Add.Name = "LookupSheet"
j = 1
For i = 1 To prod
Columns(i).Copy Sheets("LookupSheet").Cells(1, j)
j = j + 2
Next i
For j = 1 To prod * 2 Step 2
For i = 2 To Sheets("LookupSheet").Cells(Rows.Count, j).End(xlUp).Row
str = Replace(Replace(Sheets("LookupSheet").Cells(i, j), " ", ""), "cm", "")
Sheets("LookupSheet").Cells(i, j + 1) = Left(str, InStr(str, "x") - 1) _
* Mid(str, InStr(str, "x") + 1, 999)
Next i
Next j
End Sub
This simple code creates a lookup sheet with the corresponding values. The code ignores any spaces present between the texts.
LookupSheet:
Since you have 15 different products, run this macro to extract the lookup data. This should be a one time activity unless you have additional products.
2) Assuming you enter the product and dimensions to F5 and F6, i would suggest you to data validation with dropdowns to select from the list,
3) Using a worksheet_change event, detect for changes in F5 and F6,
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim str As String, result As Integer, i As Long
'F5 and F6 contains Product and Size repectively
If (Target.Address = "$F$5" Or Target.Address = "$F$6") _
And Range("F5") <> "" And Range("F6") <> "" Then
str = Replace(Replace(Range("F6"), " ", ""), "cm", "")
result = Left(str, InStr(str, "x") - 1) * Mid(str, InStr(str, "x") + 1, 999)
j = 8
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, i) <> Range("F5") Then
Range("E" & j) = Cells(1, i)
j = j + 1
End If
Next i
End If
End Sub
This code automatically populated the rest of the product types in the column E,
4) The variable result would contain the product/area of the value that you provide in F6. The only task pending would be to loop through the lookup sheet to find the nearest match. The Algorithm is below,
Algorithm:
Compare cell F5 with the data in row 1 of lookup sheet (need to loop)
If they are equal, ignore and move to next value. If not, need to loop the immediate next column to find the next match, and populate the result in the corresponding cell in source sheet.
Algorithm for column wise looping is below,
Steps:
diff = cell.value - result
if diff < 0 then multiply diff by -1
loop:
nextdiff = nextcell.value - result (multiply by -1 if negative)
if nextdiff < diff then
diff = nextdiff
end if
end loop:
The cell value with the least difference would be your best match for that particular product type.
Bit lengthier explanation, hope this helps.
The program I am working on involves reading and determining the difference between i - (i+1) and i-(i-1) from excel.
If the difference exceeds 4 then the program deletes the row at i.
The program works well at the first try. Suddenly, it says that "You can not change part of an Array".
Option Explicit
Sub Data_Delet()
Dim a As Double, b As Double, c As Double, i As Double
Dim rkill As Range
' a,b, and c are used as steps in order to proceed to the next data points
a = 18
b = 0
c = 0
With ThisWorkbook.Worksheets("Sheet1")
' The second do loop delete data points that does not follow the requirements
Do
If Abs(.Cells(a - 1, 2) - .Cells(a, 2)) > 4 And Abs(.Cells(a, 2) - .Cells(a + 1, 2)) > 4 Then
If rkill Is Nothing Then
Set rkill = Rows(a)
Else
Set rkill = Union(rkill, Rows(a))
End If
End If
a = a + 1
Loop Until .Cells(a, 2).Value = ""
If Not rkill Is Nothing Then rkill.EntireRow.Delete
' The third Do loop determines the number of data points that are still present after deleting the data points
Do
i = .Cells(17 + c, 1)
c = c + 1
Loop Until .Cells(17 + c, 1).Value = ""
' The if statment determine whether or not the number data points from before are the same after deletion process
If b = c Then
.Cells(2, 5) = "N"
Else
.Cells(2, 5) = "Y"
End If
' c is the number of data point after deletion
.Cells(12, 5) = c
End With
End Sub
The error "You cannot change part of an array" on rkill.EntireRow.Delete means that the row you want to delete is intersecting a range referenced in an array formula (a formula with braces).
Excel does not allow this. One way would be to remove the offending array formula(s) at the start of your code, and redefine it/them again at the end of your code. Or find a solution to turn these array formulas into normal formulas.
For example:
695678 needs to be 1
695678 needs to be 1
695678 needs to be 1
695678 needs to be 1
695683 needs to be 2
695683 needs to be 2
695683 needs to be 2
696217 needs to be 3
696217 needs to be 3
I got this list of ID's (every number corresponds to a person) However these numbers for example 695678, 695683, 696217 don't go up by one. They are all ranked from low to high. Is there a way to automatically change these values to 1,2,3,... and so on by changing the lowest value to 1 and the second lowest value to 2 and so on. (can't figure out how to do it with macro's)
One note is that the IDs are repeated as these people made more then one transaction.
thanks!
If you require a VBA solution, then:
Sub Renumber()
Dim N As Long, I As Long, OldValue As Long
Dim K As Long
K = 1
N = Cells(Rows.Count, "A").End(xlUp).Row
OldValue = Cells(1, 1).Value
For I = 1 To N
If Cells(I, 1).Value = OldValue Then
Cells(I, 1).Value = K
Else
OldValue = Cells(I, 1).Value
K = K + 1
Cells(I, 1) = K
End If
Next I
End Sub
#Gary's Student, your solution close to perfect, I've looked into this and added a small correction, Compiling it gives an runtime error, your K value is 1 and in your else clause it just takes the same value again.
After adjusting it to their excel file it worked perfect:
Sub Renumber()
Dim N As Long, I As Long, OldValue As Long
Dim K As Long
K = 1
N = Cells(Rows.Count, 2).End(xlUp).Row
OldValue = Cells(2, 2).Value
For I = 2 To N
If Cells(I, 2).Value = OldValue Then
Cells(I, 2).Value = K
Else
OldValue = Cells(**I + 1**, 2).Value
K = K + 1
Cells(I, 2) = K
End If
Next I
End Sub
The I + 1 between ** is the part that bugged.
I've also changed the cell indexes accordingly.
Kind regards,
David
Please try:
=IF(ISBLANK(A1),1,IF(A1=A2,B1,B1+1))
copied down to suit (with a blank in the top row of data).
To try to clarify, assumes data is in ColumnA but starting in A2 (A1 and B1 being blank), that the formula above is placed in B2 and copied down to suit.
First the test is whether A1 is blank (if True, returns 1 the start point - though this could be keyed into B2 and a simpler formula then used in B3 and so on). If A1 is not blank then there is a further test, whether or not the value has changed. If it has not (True), then use the value immediately above, if it has changed (False) use the value immediately above incremented by one.
Another formula incase your data ever needs to be unsorted, and should be faster then any Macros:
=SUMPRODUCT( (FREQUENCY($A$1:$A$9, $A$1:$A$9) > 0) * (A1 >= $A$1:$A$10) )
I sometimes work with symmetric matrices in MS-Excel (both v2007 and v2003).
Is there an option to help me to copy expressions from the lower triangle to the upper one?
It should be something like copy and paste/transponse but those functions normally work only with rectangular areas.
in the added picture you can see an exemple of an expression that I have to replicate by linking the symmetric value in the superior triangle of the matrix.
To get the number in the appropriate cell, we can use OFFSET and the cell address the forms the base of the table. Note that the formula will produce a *Circular Reference` error if entered in on the diagonal. The formula will work for both sides of the diagonal - you just have to decide which one will hold the data, and which will hold the formula.
Offset takes Row and Column to decide the target. By subtracting the base cell row and column from the current position, we can invert the row and columns, and get the data.
Using your example, with the origin of the table in B2, we end up with the following formula:
=OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))
you can copy this formula into the cells, and get the reflection. Now you have the number, you can do any calculation you require on the reflection. Using your example, this would make the formula:
=10-OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))
Result:
Using INDEX to make it non volatile would change the formula slightly. First, we would need a reference to the entire table, not just the top cell. Second, we would need to add 1 to the row/column calculation, as it refers to the first cell as row/column 1, not an offset of 0 as the previous formula.
=INDEX($B$2:$K$11,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
and your example of 10-Cell would become:
=10-INDEX($B$2:$K$11,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
As one of the above answers demonstrates, this can be done by using Excel formulas. I however find this to be a very tedious procedure. Especially if this is something you need to do on a regular basis. In that case VBA could save you a lot of time.
The following code will work on a square selection and fill the rest of the matrix no matter if it is the lower- or upper part of the matrix that is pre-filled.
Option Explicit
Sub FillSymetricMatrix()
Dim i As Integer, j As Integer
Dim SelRng As Range
Dim FillArea As String
Dim FRow As Integer
Dim FCol As Integer
Set SelRng = Selection
FRow = SelRng.Rows(1).Row
FCol = SelRng.Columns(1).Column
'Returns information about which area to fill
If ActiveSheet.Cells(FRow + SelRng.Rows.Count - 1, FCol).Value <> vbNullString Then 'Lower filled
If ActiveSheet.Cells(FRow, FCol + SelRng.Columns.Count - 1).Value = vbNullString Then 'Upper empty
FillArea = "Upper"
Else
FillArea = "Error"
End If
Else
If ActiveSheet.Cells(FRow, FCol + SelRng.Columns.Count - 1).Value <> vbNullString Then 'Upper filled
FillArea = "Lower"
Else
FillArea = "Error"
End If
End If
'Determines if the selection is square
If SelRng.Rows.Count <> SelRng.Columns.Count Then FillArea = "Error"
'Fills empty area of the square (symetric) matrix
Select Case FillArea
Case Is = "Upper"
For i = 0 To SelRng.Rows.Count - 1 Step 1
For j = 0 To SelRng.Columns.Count - 1 Step 1
If i <= j Then ActiveSheet.Cells(i + FRow, j + FCol).Value = ActiveSheet.Cells(j + FRow, i + FCol).Value
Next j
Next i
Case Is = "Lower"
For i = 0 To SelRng.Rows.Count - 1 Step 1
For j = 0 To SelRng.Columns.Count - 1 Step 1
If i <= j Then ActiveSheet.Cells(j + FRow, i + FCol).Value = ActiveSheet.Cells(i + FRow, j + FCol).Value
Next j
Next i
Case Else
MsgBox "The procedure cannot be performed on the current selection!"
End Select
End Sub
I guess what you need is a function which returns the "diagonal" value of a square matrix, e.g. for any X(j,k) return X(k,j)
Try this:
Function DIAGONAL(Arg As Range, Reference As Range) As Variant
Dim MyRow As Long, MyCol As Long
If Reference.Rows.Count <> Reference.Columns.Count Then
DIAGONAL = CVErr(xlErrRef)
Else
MyRow = Arg.Row - Reference.Row + 1
MyCol = Arg.Column - Reference.Column + 1
If MyRow < 1 Or MyCol < 1 Or MyRow > Reference.Rows.Count Or MyCol > Reference.Columns.Count Then
DIAGONAL = CVErr(xlErrNA)
Else
DIAGONAL = Reference(MyCol, MyRow)
End If
End If
End Function
once you entered this function in VBA, you can use it inside or outside your square matrix ... you just need to ensure that your argument (parameter: Arg) is within the matrix (parameter: Reference) ... or you get an #N/A error. Or you get a #REF error if the matrix isn't square.
So in your example you would enter into B4: =10-DIAGONAL(B4,$B$2:$K$11) and copy this throughout the lower triangle.
You can even transpose a complete matrix ... in your screen shot, move to cell B13, enter =DIAGONAL(B2,$B$2:$K$11) and copy 9x down & right
No buttons, no need to explicitely start a Sub ... any size of n x n matrix, handles strings and numbers, ...
Here is an example with VBA. Start with an un-filled table and a button.
Then make the button run the code:
Option Explicit
Private Sub symmButton_Click()
MakeSymmetric Range("B2")
End Sub
Public Sub MakeSymmetric(ByRef r As Range)
Dim M As Long
M = CountCols(r)
Dim vals() As Variant
vals = r.Resize(M, M).Value2
Dim i As Long, j As Long
For i = 2 To M
For j = 1 To i - 1
vals(i, j) = vals(j, i)
Next j
Next i
r.Resize(M, M).Value2 = vals
End Sub
Public Function CountCols(ByRef r As Range) As Long
If IsEmpty(r) Then
CountCols = 0
ElseIf IsEmpty(r.Offset(0, 1)) Then
CountCols = 1
Else
CountCols = r.Worksheet.Range(r, r.End(xlToRight)).Columns.Count
End If
End Function
and finally observe the results
Similar to Sean's solution, I would also use formulas. In order to get the transposed value, use this formula:
=INDEX($B$2:$G$7,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
If you want to do a more complex operation (e.g. =10-[transposedValue]), I'd recommend you use a named range: Insert a new name, e.g. TransposedValuein the Name Manager. Instead of a cell link, provide the above formula. Now you can literally write the following formula in your matrix:
=10-TransposedValue
I have this way. As you said copy paste transpose work on rectangular range. And your problem is that you have a triangular range.
You will love this....
1). Select the square range containing your upper triangular matrix and Copy.
2). Select a cell in an empty place and do the following two steps
a.) Paste Special - Values
b.) Paste Special - Values - Transpose - Skip Blanks
And you have got your symmetric matrix :-)
Anil.
Mixing together Ja72's fill code with SeanC c's Excel function code, I think I can make a generic matrix template that is properly prefilled with the dynamic Excel formula. So dynamic, and can be reused without any copy and paste.
Public Sub MakeSymmetric(ByRef r As Range)
Dim M As Long
M = 300
' Was CountCols(r), but I just limited to 300 columns for now
Dim vals() As Variant
vals = r.Resize(M, M).Value2
Dim i As Long, j As Long
For i = 2 To M
For j = 1 To i - 1
vals(j, i) = "=OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))"
Next j
'Make diagonal down the middle show ---
vals(j, i) = "---"
Next i
vals(1, 1) = "---"
r.Resize(M, M).Value2 = vals
End Sub
Sub FillSymmetric()
MakeSymmetric Range("B2")
End Sub
I don't really know any VB though, so I haven't quite figured out how to fill the header yet. I don't know Stackoverflow yet either, but I will try to add a picture.
Original List to Matrixize
Dynamically transposing values typed in SouthWest half to NorthEast half
Short answer: INDIRECT(ADDRESS(COLUMN(D2), ROW(D2)))
Explnation: you may remember we use coordinates with numbers to represent a location in Cartesian Coordinates System. So, it's easy to get a diagonal symmetric value e.g. just change (2, 3) to (3, 2).
But in Excel, we need a wordaround if we want to do so. Because, address is marked by a combination of a letter and a digit, say B2. You can't just change B2 to 2B.
Luckily, we can still use numbers to represent a cell by leveraging the power of COW() and COLUMN().
In the image below, C2 and B3 are symmetrical. This shows how to put the value of C2 to B3.
Making the formula from C.W. more generic (similar to Peter Albert), this will help when your matrix is not starting at A1 but e.g. in C10:
=INDIRECT(ADDRESS(COLUMN(C11)-COLUMN($C$10)+1,ROW(C11)-ROW($C$10)+1))
So, subtract the origin row/column and add 1.