I need some ideas how to copy lines which matches criteria.
I have such data:
A B C D
1 Country Brand Model Year
2 France Peugeot, Citroen (France) Car 2003
3 Germany VW, Opel, BMW (Germany) Car 2003
...
The goal is that each car brand with it's parameters would be in separate lines/
What I'd like to do is to copy line #2 to the bottom of the table and copy line #3 2 times to the bottom of the table. Also create column F which shows the brand.
Result should look like this:
A B C D F
1 Country Brand Model Year
2 France Peugeot, Citroen (France) Car 2003 Peugeot
3 France Peugeot, Citroen (France) Car 2003 Citroen
4 Germany VW, Opel, BMW (Germany) Car 2003 VW
...
Also, I have Brand list in separate sheet.
Should I try search for a , or try to match those brands from list in separate sheet?
I am new with vba so any ideas, suggestions will be appreciated!
If column B always includes the country from column A in parentheses, consider removing it from the column before performing a split. Something like:
Dim originalWs as Excel.Worksheet, newWs as Excel.Worksheet
Dim countryName as String, allBrands as String, brandArray() as String
Dim rowNumber as long, nextRow as long, i as long
rowNumber = 2 : nextRow = 2
...
countryName = originalWs.Cells(rowNumber,1)
allBrands = originalWs.Cells(rowNumber,2)
brandArray = Split(Replace(allBrands,"(" & countryName & ")",""),",")
...
For i = lbound(brandArray) to ubound(brandArray)
nextRow = nextRow+1
With newWs
.Cells(nextRow,1) = countryName
.Cells(nextRow,2) = allBrands
.Cells(nextRow,3) = originalWs.Cells(rowNumber,3)
.Cells(nextRow,4) = originalWs.Cells(rowNumber,4)
.Cells(nextRow,5) = brandArray(i)
End With
Next i
...
The key is that you have to maintain separate counters for:
The row in the original worksheet
The row being inserted into the new worksheet
The brand in the array
Good luck!
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.
I have an Excel workbook I imported with 24,000 business names and addresses. I can't figure out how to separate them into different cells because no commas exist and the some businesses have multiple spaces in the name. Here is an example of what is in each column. Each line is in a separate row.
P & S DELI GROCERY 730 COLUMBUS AVENUE New York NY 10025
ANGELIKA FILM CENTER 18 WEST HOUSTON STREET New York NY 10012
SHASHEMENE INT'L RESTAURA 195 EAST 56 STREET New York NY 11203
CARVEL ICE CREAM 1006 EAST 233 STREET New York NY 10466
LEXLER DELI 405 LEXINGTON AVENUE New York NY 10174
SNACK TIME GRILL 87-69 LEFFERTS BOULEVARD New York NY 11418
MITCHEL LONDON FOODS 22 EAST 65 STREET New York NY 10065
SPOON BREAD CATERING 364 WEST 110 STREET New York NY 10025
TERMINAL CAFE/YANKEE CLIPPER 0 GUARDIA AIRPORT PARKING New York NY 11371
PLAZA BAGELS & DELI 73 NEW DORP PLAZA New York NY 10306
B & M HOT BAGEL & GROCERY 203 GIFFORDS LANE New York NY 10308
TEXAS ROTISSERIE 94 FULTON STREET New York NY 10038
One easy way to get going is to use the `Text to Columns function under the Data tab.
Highlight your cells that you want to split up, and click "Text to Columns". Choose a Delimiter, click "Next", then choose "Space".
Now, it'll take a word, put it in a cell, then take the next word (after a space), and put it in the cell next to that, etc.
The problem I forsee is this isn't going to be a one shot solution. As you mention, the restaurant names can be one word, of up to infinity words. Unless you see some logic in how it's spread out, I think this is your best bet.
For instance, is it safe to assume that if we are reading from left to right, and come across a number, that number starts the address and all preceding text is the restaurant name? ...I doubt it actually, what if my restaurant is called "Bruce's 21 Jump Street Eatery"? As #Johankr points out, this is probably more rare, but you should be aware of this possibility if you're just going to run the macro, save and close (without any human review). You could get a list of major cities, zip codes, etc. and use that to help parse through though and determine where the address starts/ends.
Copy it an paste into Google Spreadsheet and then use regular expressions (REGEXEXTRACT).
So for example to extract everything before the number use:
=REGEXEXTRACT(A1, "(\D*)\d")
It will extract P & S DELI GROCERY. Then to get the number use:
=REGEXEXTRACT(A1, "\D+(\d+)\D*")
It will get you 730. And so on...
This vba Should work for most of what you want:
Sub splitaddress()
Dim ws As Worksheet
Dim rng As Range
Dim oArr() As Variant
Dim lastrow As Long
Dim spltstr() As String
Dim i As Long
Dim j As Long
Dim h As Boolean
Set ws = Sheets("Sheet1")'Change to your sheet name.
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ReDim oArr(1 To lastrow, 1 To 5)
j = 1
h = False
For Each rng In ws.Range("A1:A" & lastrow)
spltstr = Split(rng)
For i = LBound(spltstr) To UBound(spltstr)
If i = UBound(spltstr) Then
oArr(j, 5) = spltstr(i)
ElseIf i = UBound(spltstr) - 1 Then
oArr(j, 4) = spltstr(i)
ElseIf Not h And spltstr(i) = UCase(spltstr(i)) And InStr("1234567890", Left(spltstr(i), 1)) = 0 Then
oArr(j, 1) = oArr(j, 1) & spltstr(i) & " "
ElseIf InStr("1234567890", Left(spltstr(i), 1)) > 0 Or (h And spltstr(i) = UCase(spltstr(i))) Then
h = True
oArr(j, 2) = oArr(j, 2) & spltstr(i) & " "
ElseIf spltstr(i) <> UCase(spltstr(i)) Then
oArr(j, 3) = oArr(j, 3) & spltstr(i) & " "
End If
Next i
oArr(j, 1) = Trim(oArr(j, 1))
oArr(j, 2) = Trim(oArr(j, 2))
oArr(j, 3) = Trim(oArr(j, 3))
h = False
j = j + 1
Next rng
ws.Range("B1").Resize(lastrow, 5).Value = oArr
End Sub
If the street address does not start with a number it will not work.
If all the contacts only exists as a string, i.e. all data in the same cell, no solution is likely to be able to be able to split all contacts properly.
Here are some starting points though, all based on the assumption that the rest of the data looks fairly similar at least.
Very few business are likely to contain numbers in the names, so you can probably safely split address using the first occurance of a number as the divider between name and adress.
Create a lookup table for State and abbreviation. Should be possible to split the adress part of the string into two parts/lines using that.
Assumptions: The City is always = "New York"; the State is always =
"NY".
Place your data in column A starting at row 2.
In columns C thru L, at row 1, type numbers 0 to 9, where each column
gets 1 of the digits (0,1,2 ... 9).
Paste the following into cell C2:
=IF(TYPE(FIND(C$1,$A2,1))=16,LEN($A2),FIND(C$1,$A2,1))
Select and copy cell C2, select range D2:L2 and paste the copied
formula from cell B2.
Paste the following into cell B2: =MIN(C2:L2)
Paste the following into cell M2: =TRIM(MID(A2,1,B2-1))
Paste the following into cell N2: =TRIM(MID(A2,B2,FIND("New York_
NY",A2,1)-1-B2))
Type "New York" in cell O2.
Type "NY" in cell P2.
Paste the following into cell Q2: =RIGHT(A2,5)
Next select copy range B2:Q2 and paste it in rows B3 to end of your
data.
In column B of Sheet1 I have a list of divisions that coincide with ship dates. I need the divisions to be copied from Sheet1(columnB) to Sheet2(columnC). The divisions go from row 3 to 17 and once the macro gets to the division in row 17 I need it to start over with the division in row 3 and add to the bottom of the column. Here is what I have but it doesn't give me any output.
For i = 2 To 2
For y = 3 To 17
x = x + 1
Sheets("Sheet2").Cells(x, 3).Value = Sheets("Sheet1").Cells(y, i).Value
Next y
Next i
Input:
Atlanta
Cincinnati
Columbus
Michigan
Central
Louisville
Delta
Nashville
Mid-Atlantic
Southwest
Charleston
Indiana
Southwest
Dillon
California
Output:
Atlanta
Cincinnati
Columbus
Michigan
Central
Louisville
Delta
Nashville
Mid-Atlantic
Southwest
Charleston
Indiana
Southwest
Dillon
California
Atlanta
Cincinnati
Columbus
Michigan
Central
Louisville
Delta
Nashville
Mid-Atlantic
Southwest
Charleston
Indiana
Southwest
Dillon
California
Your Outer For Loop For i = 2 To 2 runs only once, change it to For i = 1 To 2 to run two times and n to run n times etc
x = 3
For i = 1 To 2
For y = 3 To 17
Sheets("Sheet2").Cells(x, 3).Value = Sheets("Sheet1").Cells(y, 2).Value
x = x + 1
Next y
Next i
You can do this with a single loop, might be easier if you instantiate a few range variables. As others have noted, your outer loop is beginning at "2" and ending at "2", so that is why it is not repeating as you intend.
Sub fillValues()
Dim i As Integer
Dim howManyTimes as Integer
Dim copyRange As Range
Dim pasteRange As Range
Dim rowCount as Long
howManyTimes = 2 'modify as needed; tells the procedure how many times to loop
'## Define the range to "copy"
Set copyRange = Sheets("Sheet1").Range("C3:C17")
'## Get the # of rows in this range
rowCount = copyRange.Rows.Count
'## Define the original destination to "paste":
Set pasteRange = Sheets("Sheet2").Range("A3") 'this will be modified later
'## Loop and input the values:
For i = 1 To howManyTimes
pasteRange.Offset((i - 1) * rowCount).Resize(row.Count).Value = copyRange.Value
Next
End Sub
Try:
set sht1 = ThisWorkbook.sheets("Sheet1")
set sht2 = ThisWorkbook.sheets("Sheet2")
set rng = sht1.Columns(2).UsedRange
j = 1 ' Change for where you want it to start
for each cell In rng.cells
sht2.cells(1,j) = cell
j = j + 1
next cell
You can accomplish this pretty easily without VBA. In column C of Sheet2, enter:
=INDEX($B$3:$B$17,MOD(ROW(C1)-ROW($C$1),COUNTA($B$3:$B$17))+1)
And just copy down as far as you want to go. Change $C$1 to the first row of the Sheet2 column.
OPTIONAL:
I also suggest using Named Ranges to make life easier when you come back a year later and can't remember what you were doing. So, do:
Formulas->Define Name->DivisionsList in Name field, =Sheet1!$B$3:$B$17 in Refers to: field->OK
And:
Formulas->Define Name->FirstRow in Name field, =Sheet2!$C$1 in Refers to: field->OK
Then just enter this in Column C of Sheet2 and copy down:
=INDEX(DivisionsList,MOD(ROW(C1)-ROW(FirstRow),COUNTA(DivisionsList))+1)
Change the address of FirstRow as necessary.
I have two data ranges:
DataRange is the range in Sheet1 (something like A16:F30)
HoursDataRange is the range in Sheet2 (something like A17: G90).
I need to loop via DataRange rows, take values from row, do some manipluation (like adding those data into seeprate wrokbook), as well, as take corresponding cell in column A and find all rows in Sheet2 (HoursDataRange). I do not know how to do the last thing - find all matching rows in Sheet2.
I am not familiar with VBA yet, so I have read that I can use AutoFilters to filter HoursDataRange or lookups or loops.
What is the best solution?
As I am programmer, I do understand loops, but I am not so familar with VBA.
Here is a shortenedn example of Sheet1:
NAV Nr. CompName VAT Nr. Adress Name Type
101 Int1 1 Address1 Au 1
103 Int2 2 Address2 De 1
210 Int3 3 Address3 Es 1
212 Int4 4 Address4 Sw 1
310 Int5 5 Address5 Fi 1
345 Int6 6 Address6 Fr 1
And here is shortened example of Sheet2:
Key Acc Key NAV Nr. Client EUR
3 Bu STA BU 212 Cl1 25,00
4 Bc STA BC 101 Cl2 25,00
1 Bu STA BU 212 Cl1 25,00
2 Bc STA BC 101 Cl2 25,00
So, you see the column Nav Nr. is in both sheets and there are matching values. We can assume that each Nav Nr. occures only once in Sheet1 and I am already looping via Sheet1 DataRange. However, in Sheet2 given Nav Nr can appear from 0 to N times. So I need to find all matching rows (I need to find the whole row and not just cell, because I need manipulations for the all values in rows, for example, Later I would have to sum up EUR column by Nav Nr. and create PDF, but this woudl be later staff. FOr now I just want to know how to find those matching rows.
You'll just want to do exactly as you describe. Here's an example:
Sub renathy()
Dim Cdata As Range
Dim Chour As Range
For Each Cdata In Sheets("Sheet1").Range("A:A")
If Cdata <> "" Then
For Each Chour In Sheets("sheet2").Range("A:A")
If Cdata = Chour Then
'do stuff
End If
Next
End If
Next
End Sub
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))