As am new to VBA, I will be thankful if anyo can help me with this.
I want to sort rows based on the presence or absence of a specific text in the whole string.
Range B Contains:
Audi Car, Suzuki Bike, Honda Car, Volvo Bus, Benz Car, Yamaha Bike
So I want VBA code which sorts based on if its a CAR, BIKE or BUS.
After Executing, Range B should be sorted this way:
Audi Car, Benz Car, Honda Car, Suzuki Bike, Yamaha Bike, Volvo Bus
Please help.
If I where to handle a problem like this I would first make an array with all the different entities.
The next thing you can do is to use the InStr(startsearchingposition, String, searchforvalue). The InStr method returns the startposition of searchvalue in String, else it returns 0 or NUll.
So if it has a record the value of Instr returns is greater than 1.
Dim myArray(1 to 3) As Variant, i, number_of_element As Integer, y as String
Dim ws As Worksheet: Set ws = ActiveSheet
myArray(1) = "Car"
myArraY(2) = "Bus"
myArraY(3) = "Bike"
'Lets assume that all you data is in column A
For i = 1 To ws.Cells(rows.count, 1).end(xlup).row
y = ws.Cells(i,1).value
number_of_element = 1
For Each element in myArray
If InStr(1, y, element) > 1 Then
ws.cells(i, number_of_element +1).value = y
Exit For
Else
number_of_element = number_of_element + 1
End if
Next
Next i
Maybe this doens't completely satisfied you criteria but at least all the different entities are now parted.
The Next thing you could do is sort all the elements in every entity en put them back together.
VBA has some useful methods that can be used to parse a certain string.
Mid() and InStr() are the two I use the most.
use Macro to record the following steps:
1.paste data vertically in column A (paste special - transpose)
2.insert function Split by Space to column B (return value eg: bike, car)
3.sort column A and B in the order you like
4.copy column A and paste special - transpose
5.stop Macro recording, change all cells (eg: .range(row,col))
Related
I'm a bit of an Excel noob so bear with me here. I have the following abridged sheet:
Sheet1
H AP AO
1 Transaction Description Employee Name Type
2 ER 12345678 blank blank
3 ER 13182984 blank blank
4 ER 18213289 blank blank
5 ER 13829429 blank blank
6 ER 89234024 blank blank
And another sheet in the same file to reference the names against:
Sheet2
E I
1 Expense Report Number Employee Name
2 12345678 Chris Rock
3 13182984 Hank Hill
4 18213289 Tom Sawyer
5 13829429 Elon Musk
6 89234024 Tupac Shakur
And I was wondering how to efficiently fill in the first excel sheet's Employee Name and Type columns from the matching report number of the second sheet as such:
Sheet1
H AP AO
1 Transaction Description Employee Name Type
2 ER 12345678 Chris Rock A
3 ER 13182984 Hank Hill A
4 ER 18213289 Tom Sawyer A
5 ER 13829429 Elon Musk A
6 ER 89234024 Tupac Shakur A
My attempt so far:
Set RE = CreateObject("vbscript.regexp")
RE.pattern = "(\d{8})"
Set allMatches = RE.Execute(ActiveSheet.Region ("H:H") #extract the 8 numbers
#somehow extract the 8 numbers to reference against the second sheet
With .Columns(AP)
.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Formula = "=IF(ISERROR(VLOOKUP(reference number,EEM BI + mapping!I:I,2,0)),""Check employee ID"",VLOOKUP(reference number,EEM BI + mapping!I:I,2,0))"
As you can see I'm pretty lost in this code.. Any help is much appreciated
try this test code
Sub Test()
Dim ddd As Variant ' convert sheet1.columnH into an array
ddd = Sheets("Sheet1").Range("h2:h6").Value ' 2D array 1 x N
ddd = Application.Transpose(ddd) ' 2D array N x 1
ddd = Application.Transpose(ddd) ' this changes to 1D array
Dim i As Integer
For i = 0 To UBound(ddd) ' remove the "ER" from each member of the array
ddd(i) = Split(ddd(i))(1)
Next i
Dim findMe As String
Dim rng As Range
For Each rng In Sheets("Sheet2").Range("e2:e6")
findMe = rng.Value
For i = 1 To UBound(ddd)
If StrComp(findMe, ddd(i), vbTextCompare) = 0 Then
Sheets("Sheet1").Range("ap1").Offset(i) = rng.Offset(0, 4).Value
Sheets("Sheet1").Range("ao1").Offset(i) = "A"
End If
Next i
Next rng
End Sub
In your table in Sheet1 if the 8 digit number always starts at position 4, as you show, you can use the MID function seen in the formula below. If not, we would merely have to change MID to something a bit more complex, depending on the real data. No need for REGEX unless the text analysis is complex.
Given the order of Employee Name and Expense Report Number in your lookup table, INDEX(MATCH(... would be one solution.
Although you could use LOOKUP, it may be more efficient to use INDEX(MATCH.... LOOKUP, among other things, to work properly, requires that your lookup table be sorted. That is not necessary with INDEX/MATCH.
Something like
=INDEX(EmployeeName,MATCH(--MID(H2,4,8),ExpenseReportNumber,0))
For efficiency, the references to the two columns (EmployeeName and ExpenseReportNumber) should be as short as possible. Whole column references (eg: $E:$E and $I:$I will work, but will take longer to execute.
My Bigcommerce site has Categories that have Parent/Child setups (for exmaple):
Food>
Jam>
Coffee>
Clothes>
Shirts>
Dress>
T-Shirts>
When I pull the Categories from the API, it gives me the Category name, and each Categories Parent Category in an excel sheet:
ID Parent Name
101 0 Food
102 101 Jam
103 101 Coffee
I am trying to create the taxonomy so I get
Food
Food>Jam
Food>Coffee
Clothes
Clothes>Shirts
Clothes>Shirts>Dress
I have been struggling to find a way using loops in VBA to get this end result, without success.
Not looking for you to write my code, but any guidance on the best way to approach this?
this is some code to get you in the right direction
input
output
my code which is looping through the special cells and concat them and add the results to new sheet
Sub ashTax()
Dim wsCopyFrom As Worksheet
Dim wsCopyTo As Worksheet
Dim rng As Range
Dim cell As Range
Dim str As String
Set wsCopyFrom = ThisWorkbook.ActiveSheet
ThisWorkbook.Worksheets.Add after:=wsCopyFrom
Set wsCopyTo = ThisWorkbook.ActiveSheet
Set rng = wsCopyFrom.UsedRange.SpecialCells(xlCellTypeConstants)
wsCopyTo.[a1].Value = "Results"
For Each cell In rng
str = str + cell.Value
Cells((Cells(Rows.Count, "a").End(xlUp).Row) + 1, "a").Value = str
Next
End Sub
Your structure is similar to a paragraph numbering structure or a WBS (work breakdown structure)
In a paragraph numbering structure the ID for the sub or sub-subparagraph is the right-most number:
1.1.2.3 Whatever
the 3 is the ID for the paragraph. In your case, it appears that the item ID is the left-most number.
I would go through the data in two passes:
in the first pass build up a translate table associating the Name of an item with its Number
in the second pass, replace the numbers with the associated name and format properly the right-to-left nature of each record
Once you have firmed-up your approach and written some code, we can help you further.
data in excel:
1 Mary
1 John
1 Sam
2 Alaina
2 Edward
Result I expected was:
1 Mary, John, Sam
2 Alaina, Edward
User allquixotic answered a very similar question. Source here
This is his VBA approach:
Option Explicit
Function allquixotic(param As Variant, search As Range, values As Range, Optional absolute As Boolean = False) As String
Dim sep As String, retval As String
Dim i As Integer, rownum As Integer
Dim look As Range, j As Range
sep = ", "
retval = ""
For i = 1 To search.Rows.Count
Set look = search.Cells(i, 1)
If absolute Then
rownum = look.Row
Else
rownum = i
End If
If look.Value = param Then
If absolute Then
Set j = values.Worksheet.Cells(rownum, values.Column)
Else
Set j = values.Cells(i, 1)
End If
retval = IIf(retval = "", retval & j.Value, retval & sep & j.Value)
End If
Next
allquixotic = retval
End Function
Use the worksheet function (feel free to rename it) by using a formula like
=allquixotic(A1,$A$1:$A$15,$B$1:$B$15,true)
Use the fill handle to put the formula in all the cells
The parameters are the following:
=allquixotic(look_cell, key_range, value_range, absolute)
look_cell: The first parameter, should be a single cell or a value literal. Valid input includes things like 3, $6.25, "Hello", etc. This is the value that you are trying to find in key_range.
key_range: This should be a range of cells (more than one cell); if absolute is true then you will get very strange results unless this is a contiguous range (all the values are in sequential rows).
value_range: This should be a range of cells (more than one cell); if absolute is true then you will get very strange results unless this is a contiguous range (all the values are in sequential rows).
absolute: If true, then we will use the absolute row number (relative to the number of rows in the entire spreadsheet) of each "found" row in the key_range to determine what row to extract a value from value_range on. If false, we will use relative numbers; for instance, if we find a match in the third row of key_range, then we will extract the value from the third row of value_range. Recommended value is FALSE, or you can omit it to default to that.
Note: This function does not support the case where the key and value ranges are in columns, but it should be fairly easy to adapt it to that.
Also, if you specify multiple columns in either the key_range or the value_range, only the leftmost column will be used.
Again, all credit goes to allquixotic.
I have looked at a bunch of questions like this, but I have only found formulas, and VB examples that don't appear to check the values of cells in a column.
I was able to derive the following formula in Excel:
=IF(AND(ISNUMBER(SEARCH("Cat",R2)),OR(ISNUMBER(SEARCH("5E",R2)),ISNUMBER(SEARCH("6",R2))), ISNUMBER(SEARCH("Patch",R2)), ISNUMBER(SEARCH("Cables",R2))), "CAT 5E Ethernet Cables")
The problem is that this formula only checks for 1 out of 500 possible values. This is not productive. Plus, I have to make it one big formula when I check the entire row, because if I don't, the formula overwrites the result of the previous formula...
So, Visual Basic... I think I may have better luck scripting some kind of IF ELSE or CASE statement. I just do not understand how to do this in excel. I need to achieve the same thing as the formula above, but instead of checking for one set of conditions,
I need to check for multiple, and populate the S & T columns based on the result of each set of conditions.
I found this webpage that just mentions Excel and shows a VB IF - ELSE statement. How can I make this statement check Excel columns?
I tried the selected answer in this post with no luck:
Private Sub UpdateCategories()
Dim x As Long
For x = 1 To 5000
If InStr(1, Sheet1.Range("$B$" & x), "cat") > 0 And InStr(1, Sheet1.Range("$B$" & x), "5e") > 0 Then
Sheet1.Range("$T$" & x) = Sheet1.Range("$T$" & x) & "CAT 5E Ethernet Cables (Test)"
End If
Next
End Sub
Any help is appreciated. Thanks in advance!
Assuming you choose the route of using a data table sheet to compare to your string.
You would need to have a sheet looking like this (Maybe this is not what you want because I didn't thoroughly understand how your data looks like but the idea remains). You could have sub-category if you want, as well as category, in a third column.
column A | column B
keyword |category
CAT |ATX Cases
5e |Mini-ITX Cases
important words |MicroATX Cases
...
This would need to be filled manually. I'm not sure about the amount of data you're looking at. It can be pretty rapid if you can copy/paste stuff efficiently, depending on the form of your data.
When you have that, loop using this code. I assume the data table is in Sheet1, columns A and B and the values are in Sheet2, column A.
dim listLength as integer 'number of values to look at
dim i as integer
dim dataLength as integer 'number of keywords
dim j as integer
dim keyword as string
dim value as string
listlength = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row - 1 'assuming you start on row 2
datalength = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row - 1 'assuming you start on row 2
for i = 2 to listLength + 1
value = Sheet2.Range("A")(i)
for j = 2 to dataLength + 1
keyword = Sheet1.Range("A")(j)
if instr(value, keyword) <> 0 then
' what happens when the keyword is present goes here
end if
next j
next i
ID Student Name
34534 22222 Block Project
56653 11111 Rocket Science
12222 33333 Big Bang Project
13245 44465 Explosive Science
88888 59833 Audio Analytics
The above are just a mini portray of the data as I have over 80 columns of data. Since we can be editing or adding columns anytime in between, how can I add or delete the columns with the name based on the first row of data?
Deletion:
Dim vNoCopy As Variant, v As Long
vNoCopy = Array(5, 6, 7, 11, 13)
With altwb.Sheets("CRIMS_ams_report_all_ccr")
For v = UBound(vNoCopy) To LBound(vNoCopy) Step -1
.Columns(vNoCopy(v)).EntireColumn.Delete
Next v
.Copy After:=activeWB.Sheets(activeWB.Sheets.Count)
End With
So in deletion, I'm declaring the position of the column using numbers and delete it accordingly. Is it possible to change the array of numbers as the first row of the words? (Id, Student, name etc.)
Addition:
data.Columns("A").Copy .Range("A" & myCount) 'Change Columns("A") into something like student? ID?
The copy of columns is pretty simple. Any shortcut for these?
You can retrieve the column's ordinal (number) with Application.Match and use that to identify the column(s) to delete.
Dim vNoCopy As Variant, v As Long
vNoCopy = Array("Name", "Student", "Id")
With altwb.Sheets("CRIMS_ams_report_all_ccr")
For v = UBound(vNoCopy) To LBound(vNoCopy) Step -1
if cbool(application.countif(.rows(1), vNoCopy(v))) then _
.Columns(application.match(vNoCopy(v), .rows(1), 0)).EntireColumn.Delete
Next v
.Copy After:=activeWB.Sheets(activeWB.Sheets.Count)
End With
That assumes no misspelling (but can be non-case-sensitive) and that the column exists. I've added COUNTIF to check that the column exists before attempting to remove it. Without the check, any failure would crash the procedure.