I currently have an algorithm that manipulates data on sheet 24 in my excel workbook. I have 3 integers, a, b, and c, that come from data on sheet 24, and I need to use them to return a unique row ID on sheet 14. A, B, and C, each represent their corresponding Column (range) on sheet 14 IE: Int a from sheet 24 is in column A on sheet 14. Int b in column b, and c in c. The numbers combined will always return a singular row ID from 14, in the case, integer row. I'm having a hard time writing a statement with Filter, evaluate, and a bunch of other Excel functions. Does anyone know how to launch a script from an algorithm executing on one sheet and just pull a row ID in sheet 14 using its' resulting three search numbers for a,b,c?
row = Sheets("Physical Disk Details").Columns("A").Find(what:=a, LookIn:=xlValues, lookat:=xlWhole) * Sheets("Physical Disk Details").Columns("B").Find(what:=b, LookIn:=xlValues, lookat:=xlWhole) * Sheets("Physical Disk Details").Columns("C").Find(what:=c, LookIn:=xlValues, lookat:=xlWhole)
This Function will return the first row number that is found to exactly match what is provided for a,b, and c. It demonstrates one of the simplest Range iteration and If/Then tests that forms the foundation of most data pattern searching subroutines you will find for Excel VBA. There are ways to streamline this code but it demonstrates the basic principle.
If you read every line of this code and understand what all of it does you can use the principles to accomplish most tasks even vaguely similar to it.
Function GetRowNumberByABCMatch(a As Integer, b As Integer, c As Integer) As Integer
Dim lastRowInDataSet As Integer
Dim i As Integer
'get last row containing data in column 1
lastRowInDataSet = Sheets("Physical Disk Details").Cells(Rows.count, 1).End(xlUp).Row
'i = current row number, start at row 1
For i = 1 To lastRowInDataSet
If Sheets("Physical Disk Details").Range("A" & i).Value = a _
And Sheets("Physical Disk Details").Range("B" & i).Value = b _
And Sheets("Physical Disk Details").Range("C" & i).Value = c Then
'all fields match, return the current row number
GetRowNumberByABCMatch = i
'stop processing and return because we found a single match
Exit Function
End If
Next i
'didn't find a matching row, return -1
GetRowNumberByABCMatch = -1
End Function
Related
I need to sort a column containing cells with the following format : "TITLE text". I know the list of possible titles, but not the texts, so what I would like to do is sort the title in a custom order (for example : PLA, ARG, FHI, BRT) that is not alphabetical. The problem is that the title and the text are in the same cell.
So, for example, here is a screen of datas I might want to work on :
How can I sort this if the cells doesn't perfectly match the list members ?
And, if possible, how to do that using a macro and not manually ?
It's not very difficult. I will try to explain how this is done.
First of all, we need to figure out a way to transfer the range of cells to be sorted to the macro. There are different ways - write the address directly in the macro code, pass it as a parameter to the UDF, get it from the current selection. We use the third method - it is not the easiest to code, but it will work with any data sets.
The main difficulty when using the current selection is that the selection can be one single cell (nothing to sort), a range of cells (and may be several columns - how to sort this?) or several ranges of cells (this is if you hold down the CTRL key and select several unconnected ranges).
A good macro should handle each of these situations. But now we are not writing a good macro, we are getting acquainted with the principle of solving such problems (Since StackOfflow is a resource for programmers, the answers here help you write code yourself, and not get ready-made programs for free). Therefore, we will ignore a single cell and
multiple ranges - we will just stop execution of macro. Moreover, if there is more than one column in the selected range, then we will not do anything either.
Also, in case a full column is selected, we restrict the range to be sorted to the used area. This will sort the real data, but not the million empty cells.
The code that does all this looks like this:
Sub SortByTitles()
Dim oCurrentSelection As Variant
Dim oSortRange As Variant
Dim oSheet As Variant
Dim oCursor As Variant
Dim oDataArray As Variant
Dim sList As String
sList = "PLA,ARG,FHI,BRT"
oCurrentSelection = ThisComponent.getCurrentSelection()
Rem Is it one singl cell?
If oCurrentSelection.supportsService("com.sun.star.sheet.SheetCell") Then Exit Sub
Rem Is it several ranges of cells?
If oCurrentSelection.supportsService("com.sun.star.sheet.SheetCellRanges") Then Exit Sub
Rem Is this one range of cells? (It can be a graphic item or a control.
Rem Or it may not even be a Calc spreadsheet at all)
If Not oCurrentSelection.supportsService("com.sun.star.sheet.SheetCellRange") Then Exit Sub
Rem Is there only one column selected?
If oCurrentSelection.getColumns().getCount() <> 1 Then Exit Sub
Rem Is the current selection outside of the used area?
oSheet = oCurrentSelection.getSpreadsheet()
oCursor = oSheet.createCursor()
oCursor.gotoEndOfUsedArea(True)
oSortRange = oCursor.queryIntersection(oCurrentSelection.getRangeAddress())
If oSortRange.getCount() <> 1 Then Exit Sub
Rem Redim oSortRange as single range (not any ranges)
oSortRange = oSortRange.getByIndex(0)
Rem Get data from oSortRange
oDataArray = oSortRange.getDataArray()
Rem Paste sorted data to the same place:
oSortRange.setDataArray(getSorted(oDataArray, Split(sList,",")))
End Sub
The getSorted() function, which is mentioned in the last line of the procedure, must take two arrays as parameters — the values of the cells to be sorted and the sort list — and return one array of sorted values.
One aspect of working with data from ranges of cells should be mentioned here. If in Excel after receiving data from the range we get a two-dimensional array, then in OpenOffice/LibreOffice we get a one-dimensional "array of arrays", each element of which is a one-dimensional array of cell values of one row. Writing to a range is done from exactly the same structure, from an "array of arrays". The first parameter of the getSorted() function is oDataArray - just such an array of arrays, this will need to be taken into account when processing data.
What will getSorted() function do? It will build a "tree" sorted by Headers from the oDataArray values. In fact, this is not a tree - it is an ascending sorted array of all Headers and all values with these Headers. The values are also a sorted array. Then the function will select from the tree those Headings that are listed in the List and remove them from the tree. If, after all the actions, some elements still remain in the sorted tree, they will be displayed at the very end.
The function will accumulate the result in a separate array of the same size as the original one. In other words, the algorithm will use three times more memory than the original sorted range - source data, a tree and result array. The function will accumulate the result in a separate array of the same size as the original one. In other words, the algorithm will use three times more memory than the original sorted range - source data, a tree and result array.
You can try to save resources and write the results directly to the original array. But I strongly advise against doing this.
The fact is that an array cell may contain not a value, but a reference to a value, and in the case of inaccurate coding, you will not get a large sorted array, but a large array of the same value (the last cell).
I deliberately do not comment on all the following code - if you can read and understand this without comment, then you will understand how actions are programmed to process data from ranges:
Function getSorted(aData As Variant, aList As Variant) As Variant
Dim aRes As Variant
Dim i As Long, pos As Long, j As Long, k As Long, m As Long, uB As Long
Dim aTemp As Variant
aTemp = Array()
ReDim aRes(LBound(aData) To UBound(aData))
For i = LBound(aData) To UBound(aData)
pos = InStr(aData(i)(0), " ")
If pos > 0 Then
AddToArray(Left(aData(i)(0),pos-1), aData(i)(0), aTemp)
Else
AddToArray(aData(i)(0), aData(i)(0), aTemp)
EndIf
Next i
m = LBound(aData) - 1
For i = LBound(aList) To UBound(aList)
k = getIndex(aList(i), aTemp)
If k > -1 Then
uB = UBound(aTemp) - 1
For j = LBound(aTemp(k)(1)) To UBound(aTemp(k)(1))
m = m + 1
aRes(m) = Array(aTemp(k)(1)(j))
Next j
For j = k To uB
aTemp(j) = aTemp(j+1)
Next j
ReDim Preserve aTemp(uB)
EndIf
Next i
For k = LBound(aTemp) To UBound(aTemp)
For j = LBound(aTemp(k)(1)) To UBound(aTemp(k)(1))
m = m + 1
aRes(m) = Array(aTemp(k)(1)(j))
Next j
Next k
getSorted = aRes
End Function
To build a sorted tree, two subroutines are used - AddToArray() and InsertToArray(). They are very similar - the first eight lines are a normal binary search, and the remaining 10-12 lines are actions when an element is not found at the end of the array, when it is found and when it is not found in the middle of the array:
Sub AddToArray(key As Variant, value As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)(0)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
ReDim Preserve aData(0 To N)
aData(N) = Array(key, Array(value))
ElseIf aData(r)(0)=key Then
InsertToArray(value, aData(r)(1))
Else
ReDim Preserve aData(0 To N)
For i = N-1 To r Step -1
aData(i+1)=aData(i)
Next i
aData(r) = Array(key, Array(value))
EndIf
End Sub
Sub InsertToArray(key As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
ReDim Preserve aData(0 To N)
aData(N) = key
Else
ReDim Preserve aData(0 To N)
For i = N-1 To r Step -1
aData(i+1)=aData(i)
Next i
aData(r) = key
EndIf
End Sub
The getIndex() function uses the same binary search. It will return the index of the element in the array if it can find it, or -1 otherwise:
Function getIndex(key As Variant, aData As Variant) As Long
Dim l&, r&, m&, N&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)(0)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
getIndex = -1
ElseIf aData(r)(0)=key Then
getIndex = r
Else
getIndex = -1
EndIf
End Function
And that's all that is needed to solve the task:
Demo file with code - SortByTitle.ods
I have the following VBA code:
Sub test2()
Dim w1 As Worksheet
Dim w2 As Worksheet
Dim k As Long
Dim c As Range
Dim d As Range
Dim strFA As String
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
w2.Cells.Clear
k = 1
With w1.Range("A:A")
Set c = .Cells.Find("FirstThing", After:=.Cells(.Cells.Count), lookat:=xlWhole)
strFA = ""
While Not c Is Nothing And strFA <> c.Address
If strFA = "" Then strFA = c.Address
If IsError(Application.Match(c.Offset(0, 1).value, w2.Range("A:A"), False)) Then
Set d = .Cells.Find("SecondThing", c, , xlWhole)
w2.Range("A" & k).value = c.Offset(1, 0).value
w2.Range("B" & k).value = d.Offset(0, 1).value
k = k + 1
End If
Set c = .Cells.Find("FirstThing", After:=c, lookat:=xlWhole)
Wend
End With
End Sub
The code works essentially like this:
Look through Sheet1 for a certain phrase.
Once the phrase is found, place the value from the cell one row over in Sheet2
Search for a second phrase.
Place the value from the cell one row over in the cell beside the other value in Sheet2
Repeat
Now. I have the same data that, don't ask me why, is in .doc files. I'd like to create something similar to this code that will go through and look for the first phrase, and place the next n characters in an Excel sheet, and then look for the second phrase and place the next m characters in the row beside the cell housing the previous n characters.
I'm not sure whether it's better to do this with a bash script or whether it's possible to do this with VBA, so I've attached both as tags.
Your question seems to be: "I'm not sure whether it's better to do this with a bash script or whether it's possible to do this with VBA"
The answer to that is: You'd need VBA, especially since this is a *.doc file - docx would be a different matter.
In order to figure out what that is, start by trying to do the task manually in Word. More specifically, how to use Word's "Find" functionality. When you get that figured out, record those actions in a macro to get the starting point for your syntax. The code on the Excel side for writing the data across will essentially stay the same.
You'll also need to decide where the code should reside: in Word or in Excel. That will mean researching how to run the other application from within the one you choose - lots of examples here on SO and on the Internet...
I would like to code the following in VBA, a function of signature
Public Function MySort( v as Variant) as Variant
that takes a variant v having names in its first columns and notes in its second, checks if it has two columns, throws an error if it hasn't, and if it has two rows, does the following : it sorts v's rows according to v's second column in decreasing, and then, inside a group of same note, sorts it alphabetically. For instance, the function MySort will send the variant
A 14
D 3
B 14
E 3
C 3
to the variant
A 14
B 14
C 3
D 3
E 3
from teh OP's comment below
I have tried this, without success :
Public Function MySort(r As Range) As Range
Dim r1 As Range
Dim r2 As Range
Set r1 = r.Columns(1)
Set r2 = r.Columns(2)
r.Sort Key1:=r1, Order1:=xlDescending, DataOption1:=xlSortNormal
r.Sort Key2:=r2, Order2:=xlAscending, DataOption2:=xlSortNormal
Tri = r
End Function
VBA Functions do not modify the values or structure on a worksheet other than the cell that they reside in. A function could be used to sort a variant array and pass the reordered results back to a sub which returns the values back into the worksheet but you are better off just using a sub to perform the sort unless you have some custom sort criteria that cannot be handled conventionally.
Sub sort_A1CR(Optional ws As Variant) 'expect a worksheet object, not a worksheet name
If IsMissing(ws) Then Set ws = ActiveSheet
With ws.Cells(1, 1).CurrentRegion
.Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
Key2:=.Columns(2), Order2:=xlDescending, _
Orientation:=xlTopToBottom, Header:=xlYes
End With
End Sub
Your sample code contradicted your results. This sorts with column A as the primary key in an ascending order. If duplicate values are found in column A then column B is used as the sub-sort in a descending manner.
I am trying to create a data validation drop down cell that displays a list of values pulled from a much larger list, but only the ones where the lookup value meet certain requirements. This would be like the SUMIF function that only adds the values where the lookup value meet certain requirements. Here is an example of my list:
V F
Apples x
Bananas x
Tangerines x
Tomatoes x x
Broccoli x
Pears x
Kiwis x
Plums x
Water melon x
Squash x x
I want only the ones with an "x" in the first column to display in the drop down.
Tomatoes
Broccoli
Squash
Also the original list can't be sorted. I am fine with using macros if that would work. I am using Excel 2010.
If you want a range of valid entries without blanks to use as a list for data validation, I suggest something like:
=INDEX($A$2:$A$11,SMALL(IF($B$2:$B$11<>"",ROW($A$2:$A$11)-ROW($A$2)+1),ROWS(C$2:C2)))
entered with Ctrl+Shift+Enter
There is about 20 minutes of explanation at https://www.youtube.com/watch?v=6PcF04bTSOM.
Without using VBA, you could create a copy of the list that is filtered. You can then reference the cells in that copy when you use data validation.
For example, you could do the following steps for your example above:
Apply a filter to the list where only those showing an x in the first column are showing. Copy the filtered list, then paste to another spot on the worksheet. Turn off the filter on the list, so it returns to normal. Go to the cell that you want to add a validation drop down to, and select data validation. Select list, then reference the copied list.
Using VBA, you could use this as a starter. The key is the Range.Validation method, which is explained in detail here. This reads your list in column A, finding those with an "x" in column B, and puts that in a validation list in cell E1.
Dim myvalidation_list As String
Dim last_row As Long, current_row As Long
last_row = Cells(Rows.Count, "A").End(xlUp).Row
For current_row = 1 To last_row
If LCase(ActiveSheet.Cells(current_row, 2).Value) = "x" Then
'put in the delimiting "," if the list already has an entry
If myvalidation_list <> "" Then
myvalidation_list = myvalidation_list & ","
End If
'add to the validation list
myvalidation_list = myvalidation_list _
& ActiveSheet.Cells(current_row, 1).Value
End If
Next
With ActiveSheet.Range("E1").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=myvalidation_list
End With
I am working with VBA in Excel to retrieve some information from the Reuters 3000 Database. The data I retrieve comes as a bidimensional array consisting of one column holding dates and other column holding numeric values.
After I retrieve the information, a process that takes no more than 2 seconds, I want to write this data to a worksheet. In the worksheet I have a column with dates and several other columns with numeric values, each column containing values of a same category. I iterate over the rows of the array to get the date and numeric value and I keep those in a variable, then I search for the date on the date column of the worksheet and after I've found the date I write the value. Here is my code:
Private Sub writeRetrievedData(retrievedData As Variant, dateColumnRange As String, columnOffset As Integer)
Dim element As Long: Dim startElement As Long: Dim endElement As Long
Dim instrumentDate As Variant: Dim instrumentValue As Variant
Dim c As Variant: Dim dateCellAddress As Variant
Application.ScreenUpdating = False
Sheets("Data").Activate
startElement = LBound(retrievedData, 1): endElement = UBound(retrievedData, 1)
Application.DisplayStatusBar = True
Application.StatusBar = "Busy writing data to worksheet"
For element = startElement To endElement
instrumentDate = retrievedData(element, 1): instrumentValue = retrievedData(element, 2)
Range(dateColumnRange).Select
Set c = Selection.Find(What:=instrumentDate, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
c.offset(0, columnOffset).Value = instrumentValue
End If
Next element
Application.DisplayStatusBar = False
End Sub
My problem is that this process is very slow, even if I have only 5 rows in the array it takes about 15 seconds to complete the task. As I want to repeat this process several times (once per each set of data I retrieve from the database), I would like to decrease the execution time as much as possible.
As you can see, I am disabling the update of the screen, which is one of the most recurrent actions to improve performance. Does anybody have a suggestion on how I can further decrease the execution time?
PS. I know the data retrieval process does not take much because I already tested that part (displaying values on a MsgBox as soon as the data has been retrieved)
Thanks in advanced.
This is what I did to improve the performance:
Avoid selecting the cell when the value is going to be written. This was a suggestion of Tim Williams.
I set the property Application.Calculation to xlCalculationManual
Instead of using the Find() function to search for the date, I loaded all the dates from the worksheet into an array and iterate over this array to get the row number. This turns out to be faster than the Find() function.
Private Function loadDateArray() As Variant
Dim Date_Arr() As Variant
Sheets("Data").Activate
Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
loadDateArray = Date_Arr
End Function
Private Function getDateRow(dateArray As Variant, dateToLook As Variant)
Dim i As Double: Dim dateRow As Double
For i = LBound(dateArray, 1) To UBound(dateArray, 1)
If dateArray(i, 1) = dateToLook Then
dateRow = i
Exit For
End If
Next i
getDateRow = dateRow
End Function
Thank you all for your help!
By not selecting the sheet, you can add a bit more speed. Instead of
Sheets("Data").Activate
Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
loadDateArray = Date_Arr
Try
With Sheets("Data")
Date_Arr = .Range(Cells(3, 106), Cells(3, 106).End(xlDown))
End With