How to select mutiple values from excel single cell - excel

I have excel cell having multiple rows of data with image url.
Now I want to select all images having 1500 value. So basically I want to select row starting with http and ending 1500.jpg.
Please not that in my single cell values are also other than 1500.jpg.Sample data is given below
colorImages': { 'initial': [{"hiRes":"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UL1500_.jpg","variant":"MAIN","lowRes":null},{"hiRes":"https://images-na.ssl-images-amazon.com/images/I/716mECZ9JDL._UL1500_.jpg","thumb":"https://images-na.ssl-images-amazon.com/images/I/313QD20m4WL._SR38,50_.jpg","large""thumb":"https://images-na.ssl-images-amazon.com/images/I/313QD20m4WL._SR38,50_.jpg","large":"https://images-na.ssl-images-amazon.com/images/I/313QD20m4WL.jpg","main":{"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY445_.jpg":[445,117],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY500_.jpg":[500,132],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY550_.jpg":[550,145],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY606_.jpg":[606,160],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY679_.jpg":[679,179],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY741_.jpg":[741,195],"https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._UY879_.jpg":[879,231]},

Assuming data is in Column A starting from Cell A2 and all the URLs ending with 1500.jpg needs to be displayed in adjacent columns i.e. same row Column B, Column C, Column D,.... then following might help.
Sub Demo()
Dim ws As Worksheet
Dim lastRow As Long, colIndex As Long
Dim rng As Range, cel
Dim X As Long, DotCount As Long
Dim Pat As String, EndPat As String, Parts() As String
Set ws = ThisWorkbook.Worksheets("Sheet3") 'change Sheet3 to your data sheet
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'get last row with data in Column A
For Each cel In .Range(.Cells(2, 1), .Cells(lastRow, 1)) 'loop through A2 to last cell with data in Column A
colIndex = 1
Pat = "*[!&-;?-[_a-z~=!" & Chr$(1) & "]."
EndPat = "[!&-;?-[_a-z~=!" & Chr$(1) & "]*"
Parts = Split(cel.Value, """") 'split cell value into an array
For X = 0 To UBound(Parts)
If Parts(X) Like "*?.?*" Then
DotCount = Len(Parts(X)) - Len(Replace(Parts(X), ".", ""))
If """" & Replace(Parts(X), "]", Chr$(1)) & """" Like Application.Rept(Pat, DotCount) & EndPat Then
Parts(X) = ""
ElseIf Right(Parts(X), 8) <> "1500.jpg" Then
Parts(X) = ""
Else
cel.Offset(0, colIndex) = Parts(X) 'display URL
colIndex = colIndex + 1
End If
Else
Parts(X) = ""
End If
Next X
Next cel
End With
End Sub
Derived this solution using Function URLs from here.

This is done easily via VBA, but am not expert in that. So I have done some thing for you,just follow the instruction , still it is apply to get only single search entry i.e. means in a cell its find only one 1500.jpg entry.
To get second entry in the same cell you need some effort via change or get substring from the G1 Cell string and repeat the step as explained again.
In A1 Cell, put 1500.jpg
In B1 Cell, put your actual string as you have above
In C1 cell, put formula "=SEARCH(A1,B1)", which find the search 1500 in string
In D1 cell, put formula "=MID(B1,1,C1)", which extract the substring
For E1 we need reverse the string via VBA code - Add Reversestr function (To add this function, see this link)
In F1 cell, put formula "=SEARCH(CHAR(34),E1)", which search " in above reverse string
In G1 cell, put formula "=MID(B1,C1-F1+1,C1)"
Finally you get the string in G1 Cell as "https://images-na.ssl-images-amazon.com/images/I/71GOT-L%2BOSL._1500.jpg"
For VBa formula, check this links
http://analystcave.com/excel-substring-vba-substring/

Related

How to use activecell row and column in VBA function with filldown?

I wrote a function which will concatenate all the cells to the left of the cell the function is in, using a delimiter. My code is:
Public Function Concat_To_Left(delim As String)
Dim C, R As Long
Dim S As String
Dim Cell As Range
Set Cell = ActiveCell
C = Cell.Column
R = Cell.Row
S = Cells(R, 1).Value
For i = 2 To (C - 1)
S = S & delim & Cells(R, i).Value
Next i
Concat_To_Left = S
End Function
This code works if calculating a single row. The problem I'm running into is that the cell.row and cell.column seem to be saved from the first cell when I fill the function to the bottom of a column (by double clicking the bottom right of the cell in the excel sheet). This results in all cells with this function having the same value as the cell being filled down from.
Screen-Updating, Events, and Alerts are all on/true. Application.Calculation is set to xlCalculationAutomatic
Can anyone tell me how to make this function work on each cell the formula is filled down into, using the proper row and column for each cell (not that column matters when filling down)?
Scott's comment about using TEXT join worked as a workaround to what I was trying to accomplish.
=TEXTJOIN(", ",TRUE,B2:INDEX(2:2,COLUMN()-1))
The link he provided to the custom code for TEXTJOIN was very nice as well:
MS Excel - Concat with a delimiter
Adding Application.Volatile did not make my function work. I did not find a way to get my function working with fill down without needing a range parameter, so TEXTJOIN is the next best option and answers my question for now.
EDIT:
I wrote this macro to work instead of a function:
Private Sub Concat_To_Left()
Dim C, R, LR As Long
Dim Cell As Range
LR = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
C = ActiveCell.Column
R = ActiveCell.Row
For Each Cell In ActiveWorkbook.ActiveSheet.Range(Cells(R, C), Cells(LR, C))
Cell.Value = Cells(Cell.Row, 1).Value
For i = 2 To (C - 1)
Cell.Value = Cell.Value & "|" & Cells(Cell.Row, i).Value
Next i
Next Cell
End Sub
This one uses "|" as a delimiter, fills down from the active cell to lastrow concatenating every cell to the left, including blanks.

VBA Comma Separated Look-Up

I'm looking to either use a formula or VBA to lookup values in column J associated with the same ID number and put them into any starting with "Master" in Column A separated by commas.
In the example below, I would like cell J2 to return
"D, G, R, N" and if there ere any duplicates to only have them listed once. The values in column J are currently looking up values from another list using the formula :
=IFERROR(IF(ISNUMBER(MATCH(M2,Sheet1!$J:$J,0)),"N",
IF(ISNUMBER(MATCH(M2,Sheet1!$K:$K,0)),"D",
IF(ISNUMBER(MATCH(M2,Sheet1!$L:$L,0)),"R",
IF(ISNUMBER(MATCH(M2,Sheet1!$M:$M,0)),"G",
IF(ISNUMBER(MATCH(M2,Sheet1!$N:$N,0)),"F",""))))), "")
You can use this UDF. Since you're looking for a formula, put this in the blank cells in Column J.
=get_areas(C2)
Then add this in to a Workbook Module:
Function get_areas(ID As String) As String
Dim rng As Range, cel As Range
Set rng = Range("A2:A" & Cells(rows.count,1).End(xlUp).Row)
Dim areas As String
For Each cel In rng
If IsNumeric(Left(cel, 1)) And cel.Offset(0, 2) = ID Then
If InStr(1, areas, cel.Offset(0, 9)) = 0 Then
areas = cel.Offset(0, 9) & ", " & areas
End If
End If
Next cel
areas = Trim(Left(areas, Len(areas) - 2))
get_areas = areas
End Function

Search a Dynamic Number of rows in Column A for a specific string in VBA

I have a worksheet that contains a varying amount of Rows of data in Column A , within this worksheet I need to search for a specific string then copy the data contained in the Cell adjacent to it and paste into Column C, i.e if data was found in A2 then i need to copy the data from B2 and paste into C1. I can easily find and copy when the string appears once but the string will appear more than once 100% of time. here is when i run into issues.
The temporary code I have written for ease of understanding, searches the spreadsheet for the last Mention of A, get the row number, copy the B cell for that row number then pastes the value into C1.
I guess you need to use range variables for this but not 100% sure how to do it.
i have found no way to copy all mentions of A into a column, or ideally sum up the contents of the B cells. (I can do this, just long winded)
Ive placed my code below.
Sub ValueFinder()
Dim LastALocation As String
Dim ValueContent As String
LastALocation = Range("A:A").Find(What:="A", after:=Range("A1"), searchdirection:=xlPrevious).Row
ValueContent = Cells(LastALocation, 2)
Cells(1, 3) = ValueContent
End Sub
The spreadsheet that its using for more information, contains A,B,C on a loop in Column A and the odd numbers in Column B.
Thanks for any help your able to provide.
Mark
This will look for a string in Column A, and add to Column C the same row's B Column Value.
Sub find_move()
Dim foundCel As Range
Dim findStr As String, firstAddress As String
Dim i As Long
i = 1
findStr = "A"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("C" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
End Sub
Note: You should add the worksheet in front of all the range values, i.e. Sheets("Sheet1").Range("A:A").Find(...
Consider:
Sub LookingForA()
Dim s As String, rng As Range, WhichRows() As Long
Dim rFound As Range
ReDim WhichRows(1)
s = "A"
Set rng = Range("A:A")
Set rFound = rng.Find(What:=s, After:=rng(1))
WhichRows(1) = rFound.Row
Cells(1, 3) = Cells(rFound.Row, 2)
Do
Set rFound = rng.FindNext(After:=rFound)
If rFound.Row = WhichRows(1) Then Exit Do
ReDim Preserve WhichRows(UBound(WhichRows) + 1)
WhichRows(UBound(WhichRows)) = rFound.Row
Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, 3) = Cells(rFound.Row, 2)
Loop
End Sub
This code builds column C. It also builds an internal array of the row numbers in the event they are needed later.
EDIT#1:
To read about dynamic arrays:
Dynamic Arrays
or Google:
Excel VBA dynamic array

Move values of cell to next column if integer

I haven't used formulas in Excel before. Currently, the values of my cells are misaligned. What I would like to do is move the values of column F to column G if they are numerical values. For instance, in the 7th row that is displayed in my image, I'd like to move 48 over to the adjacent cell to the right. Same with 3054, 5770, and 32. However, I DON'T want to move IsCallOnly because it is an alphanumerical value. How would I go about doing this? Thanks!
In cell G2, try:
=IF(ISNUMBER(F2),F2,"")
This will tell is to copy the adjacent cell if it is a number, but leave the cell blank if it is not.
I suggest, in H1 and copied down:
=IF(G1="",F1,G1)
this looks to see if G1 is empty and if it is, take F1, otherwise take G1.
However, the number values in ColumnF are copied rather than moved, though it could be arranged for 'move' rather than 'copy, if required, with a bit of fiddling.
Neither requires VBA but if that is obligatory then it would help if you would post the code you have tried so far.
I think you are asking to move only the numbers in column F to column G?, if so maybe the following will help.
Sub MoveMyNumbers()
MoveNumbers "XXX", "F"
End Sub
.
Function MoveNumbers(ShtName As String, ColLetter As String)
Dim ws As Excel.Worksheet
Dim ColNumber As Integer
Dim lRow As Long
Dim i As Long
Set ws = ThisWorkbook.Sheets(ShtName)
lRow = ws.Range(ColLetter & ws.Rows.Count).End(xlUp).Row
'Get Column Number from column letter
ColNumber = ws.Range(ColLetter & "1").Column
For i = 1 To lRow
If IsNumeric(Cells(i, ColNumber).Value) Then
Cells(i, (ColNumber + 1)).Value = Cells(i, ColNumber).Value
Cells(i, ColNumber).Value = " "
End IF
Next i
End Function

Macro to move number with dash to new cell

In Excel, I am trying to get a macro to move numbers with a "-".
I have a column E with a list of numbers
54525841-1
454152
1365466
1254566-1
1452577-1
I want a macro to move all the numbers that have a dash or hyphen at the end to column C.
So I would need E1 54525841-1 to be moved to C1.
You'll need to change "Sheet1" to the name of the sheet where your data is.
This looks through every cell (with data) in the E column and moves the value accross to the C column if it contains a dash.
Sub MoveDashes()
Dim Sheet As Worksheet
Dim Index As Long
Set Sheet = ThisWorkbook.Worksheets("Sheet1")
For Index = 1 To Sheet.Cells(Application.Rows.Count, "E").End(xlUp).Row
If InStr(1, Sheet.Cells(Index, "E"), "-") > 0 Then
Sheet.Cells(Index, "C") = Sheet.Cells(Index, "E").Value
Sheet.Cells(Index, "E").Value = ""
End If
Next
End Sub
Does it have to be a macro? How about Advanced Filter?
Your numbers are in column E. Let's assume they have a header.
E1: Number
E2: 54525841-1
E3: 454152
E4: 1365466
E5: 1254566-1
E6: 1452577-1
In a separate area of your worksheet (let's say column G) put the following criteria:
G1: Number
G2: *-*
Your advanced filter criteria would look like this:
Anything with a "-" in it will be copied to column C.
I got it to work by this:
Sub MoveDash()
x = Range("E" & Rows.Count).End(xlUp).Row
For Each Cell In Range("E2:E" & x)
If InStr(Cell, "-") <> 0 Then
Cell.Offset(, 1) = Cell
Cell.ClearContents
End If
Next Cell
end sub
You can do this without VBA, but here is an efficient way to do it using the dictionary object.
Sub MoveNumbersWithDash()
Application.ScreenUpdating = False
Dim i As Long, lastRow As Long
Dim varray As Variant
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
lastRow = Range("E" & Rows.Count).End(xlUp).Row
varray = Range("E1:E" & lastRow).Value
For i = 1 To UBound(varray, 1)
If InStr(1, varray(i, 1), "-") <> 0 Then
dict.Add i, varray(i, 1)
End If
Next
Range("C1").Resize(dict.Count).Value = _
Application.WorksheetFunction.Transpose(dict.items)
Application.ScreenUpdating = True
End Sub
How it works:
The major theme here is avoiding calls to Excel (like a for each loop). This will make the function blazing fast (especially if you have tens and thousands of rows) and more efficient. First I locate the last cell used in E then dump the entire row into a variant array in one move. Then I loop through each element, checking if it contains a "-", if it does, I add it to a dictionary object. POINT: Add the entry as the ITEM, not KEY. This makes sure that we allow for duplicates. The variable I will be unique for each entry, so I use that as the key. Then I simple dump the entire array of cells with "-" into column C.
Why Dictionary?
The dictionary object is very fast and comes with 2 really great functions: .Keys and .Items. These will return an array of all the keys or items in the dictionary, which you can use the Transpose function on to dump an entire column of values into Excel in one step. Super efficient.

Resources