VBA code that adds responsive Shapes to the current macro [closed] - excel

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 2 years ago.
Improve this question
I'm new at coding but I've been asked to create some macro using VBA to speed up our working process in my company.
i have this code that performs a comparison macro:
Sub Compare_numbers()
Dim i As Long, LastRow As Long
Dim L, M, txt As String
LastRow = Cells(Rows.Count, "L").End(xlUp).Row
For i = 2 To LastRow
L = Cells(i, "L").Value
M = Cells(i, "M").Value
If L = M Then
txt = "they are equal"
ElseIf L > M Then
txt = "L is greater than M " & _
ChrW(&H2B61)
Else
txt = "L is less than M " & _
ChrW(&H2B63)
End If
Cells(i, "N") = txt
Next i
End Sub
this is the output of the code:
I need to add to this macro another piece of code that would replace all the arrow characters with a proper Shape from "Insert" tab (and also it should be responsive to the changing of cell's size) like the one in this sample picture:
Any idea to do this?

If you use a helper column N with the formula
=IFERROR((L:L-M:M)/ABS(L:L-M:M),0)
it will show
-1 if L < M
0 if L = M
1 if L > M
You can then easily use conditional formatting to show the arrows:
You can even hide the values if necessary so only the arrows are shown in N (just edit the rule accordingly).
I highly recommend not to use shapes for that as this will become very cumbersome, can easily fail and will put a heavy load on your sheet if the arrows have to change with the values automatically.
Also you would need to ensure that the shapes cannot be moved accidentally, because this would "destroy" the entire sheet.

Related

How to search a cell for a comma and perform one of two actions based on whether a comma was found or not? [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 3 years ago.
Improve this question
I have an excel worksheet of about 7,000 rows, each of which has a column with names that can be in various forms ([firstname lastname], [lastname, firstname], etc). I need to take all of those names and separate them into two separate columns, a first name and a last name column.
So what I want to do is write some code that will …
search for a comma in the string
if there is a comma, take all of the characters leading up to the comma and put them in the last name column. Then take all the characters after the comma and put them in the first name column
if there is no comma, just put the first string (first name) in the first name column and the second string (the last name) in the last name column.
It's been a while since I have messed around with visual basic code but I am thinking I can use some sort of find() method for the first step but after that I am completely lost. Any help would be appreciated.
After many edits....
Here is where I am at so far.
Sub WhatsInAName()
Dim N As Long, i As Long, v As String, M As Long, X As Long
N = Cells(Rows.Count, "G").End(xlUp).Row
For i = 2 To N
v = Cells(i, "G").Value
M = InStr(1, v, ",")
X = InStr(1, v, "#")
If M > 0 Then
Cells(i, "H").Value = LTrim(Mid(v, M + 1))
Cells(i, "I").Value = Left(v, M - 1)
ElseIf X > 0 Then
Cells(i, "H").Value = "email"
Else
M = InStr(1, v, " ")
Cells(i, "H").Value = Left(v, M - 1)
Cells(i, "I").Value = Mid(v, M + 1)
End If
Next i
End Sub
Edit #?
Ok so this is what I've essentially ended with. After seeing the data parsed out, it turns out there were a bunch of rows with 3 names or extra jibberish next to their name. For those I will just have to use Text-To-Columns until I figure out how to make my code more advanced to handle those issue. Thanks guys! This was a fun learning experience
Well, not the best solution, but you can do this with normal formulas and then later on paste values.
You posted you have a column with names and you want to separate into 2 columns. I made something like this:
In cell B2 my formula is:
=IF(LEN(A2)-1=LEN(SUBSTITUTE(A2;" ";""));IF(IFERROR(SEARCH(",";A2);0)=0;TRIM(MID(A2;1;SEARCH(" ";A2)-1));TRIM(MID(A2;SEARCH(",";A2)+1;99)));"Manual fix")
In cell C2 my formula is:
=IF(LEN(A2)-1=LEN(SUBSTITUTE(A2;" ";""));IF(IFERROR (SEARCH(",";A2);0)=0;TRIM(MID(A2;SEARCH(" ";A2)+1;99));TRIM(MID(A2;1;SEARCH(",";A2)-1)));"Manual fix")
Some observations:
The formula will return Manual Fix if there are 2 or more spaces in the name (composed names)
The formula only works with 2 cases: case lastname, firstname and firstname lastname. Any other case will cause an error/unexpected result
If there are extra spaces at end or start of names, it will be counted as 2 or more spaces, so the formula will return Manual Fix
As you can see in the image, Michael Jackson and Jackson, Michael is splitted correctly. Jean Claude Van Dame returns Manual Fix due to being a composed name.
Try to adapt this to your needs.
UPDATE: Uploaded a file sample to GDrive in case you want to check the formulas on live. https://drive.google.com/file/d/17Agd57sclLlNuUbhdyaHmQgKUHcRd7hO/view?usp=sharing
Consider:
Sub WhatsInAName()
Dim N As Long, i As Long, v As String, M As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To N
v = Cells(i, "A").Value
M = InStr(1, v, ",")
If M > 0 Then
Cells(i, "B").Value = LTrim(Mid(v, M + 1))
Cells(i, "C").Value = Left(v, M - 1)
Else
M = InStr(1, v, " ")
Cells(i, "B").Value = Left(v, M - 1)
Cells(i, "C").Value = Mid(v, M + 1)
End If
Next i
End Sub
For example:
This assumes that each cell contains either a comma or a space and the parsing is based on the first occurrence of the separator. Also assumes:
input data in column A
no header row (data starts in row #1)

Pulling Data From a bunch of urls [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 7 years ago.
Improve this question
New to vba. Just starting to learn. I want to pull some specific data from a website.Code I am trying to modify is from Ron Retrieving specific data from website through excel.
Now this code work on a single url. I have urls in Column A of excel sheet and I want to macro to go one by one to all urls and paste results in Column B C D respectively.
Tried as best as my limited knowledge.
Regards
The main sub will get the ratings and the number of reviews for each URL in column A and will place them in Column B and C. I hope this help you a little.
Sub main()
Dim l As Long
l = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To l
test Range("A" & i)
Next
End Sub
Sub test(URL As Range)
my_url = URL.Value
Set html_doc = CreateObject("htmlfile")
Set xml_obj = CreateObject("MSXML2.XMLHTTP")
xml_obj.Open "GET", my_url, False
xml_obj.send
html_doc.body.innerhtml = xml_obj.responseText
Set xml_obj = Nothing
Set Results = html_doc.body.getElementsByTagName("i")
For Each itm In Results
If InStr(1, itm.outerhtml, "star-img", vbTextCompare) > 0 Then
numb_stars = itm.getAttribute("title")
Exit For
Else
End If
Next
Set Results = html_doc.body.getElementsByTagName("span")
For Each itm In Results
If InStr(1, itm.outerhtml, "reviewCount", vbTextCompare) > 0 Then
numb_rev = itm.innertext
Exit For
Else
End If
Next
URL.Offset(0, 1) = numb_stars
URL.Offset(0, 2) = numb_rev
End Sub
Preview of my output:

how to create macro to get multiple value? [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
i am beginner in excel vba i have huge list where the first name and last name in one column without any space or symbol and some name are in capital alphabet and some have no capital alphabet and they are the same column what would be the popossible macro to make space batween them...or any possible way....
thanks in advance....
Not reliable but will get you there with simple names. Select the range of names and run the macro.
Sub InsertSpacesInNames()
Dim pos As Long: pos = 0
Dim uc As Long: uc = 0
For Each cell In Selection
For i = 1 To Len(cell.Value)
If Asc((Mid(cell.Value, i, 1))) >= 65 And Asc((Mid(cell.Value, i, 1))) <= 90 Then
uc = uc + 1
pos = i
End If
Next i
If uc = 2 Then
cell.Value = Mid(cell.Value, 1, pos - 1) & " " & Mid(cell.Value, pos, Len(cell.Value))
End If
uc = 0
pos = 0
Next
End Sub
My output:
This macro will work fine if and only if:
you use it with simple names (no compound names like Jean-PierreLeCosteau which's desired output is Jean-Pierre LeCosteau)
the full name has two capital letters only.
Assuming you know the first name then simple example using formulas:
A B
1 AmandaWinslet = "Amanda" & " " & RIGHT(A1, LEN(A1) - LEN("Amanda"))) // result is Amanda Winslet
The VBA way of doing this would be:
Sub AddSpace()
Range("A1") = "Amanda" & " " & VBA.Right$(Range("A1"), Len(Range("A1")) - Len("Amanda"))
End Sub
You will need to loop over the list in VBA and make FirstName a variable. Your post assumes you have the first name from somewhere

Compare first column with others three columns. Display unmatch data in last column [closed]

Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
This question does not appear to be about a specific programming problem, a software algorithm, or software tools primarily used by programmers. If you believe the question would be on-topic on another Stack Exchange site, you can leave a comment to explain where the question may be able to be answered.
Closed 8 years ago.
Improve this question
I have the table below. Basically column A is the master data.
Column B, C and D will contain the some data in column A. Column B, C and D can have common data.
I want to compare data column A to column B,C and D.
In column Result, display all unmatch data.
Give this a try:
Sub MissingItems()
Dim N As Long, I As Long, J As Long, V As String
Dim r As Range
N = Cells(Rows.Count, 1).End(xlUp).Row
J = 1
For I = 1 To N
V = Cells(I, 1).Value
Set r = Nothing
Set r = Range("B:D").Find(V, After:=Range("B1"))
If r Is Nothing Then
Cells(J, 5).Value = V
J = J + 1
End If
Next I
End Sub
Well you can use this "big" array formula:
=INDEX($A$1:$A$10;SMALL(IF(NOT(COUNTIF($B$1:$B$2;$A$1:$A$10)+COUNTIF($C$1:$C$3;$A$1:$A$10)+COUNTIF($D$1:$D$2;$A$1:$A$10));ROW($A$1:$A$10)-ROW($A$1)+1;"");ROW(A1)))
Write the formula wherever you want to obtain the first an then copy down to obtain the others.
This is an array formula so dont forget to Ctrl Shift Enter
Depending on your Regional Settings you may need to replace field separator ";" by ","
This one is smaller and still works:
=INDEX($A$1:$A$10;SMALL(IF(NOT(COUNTIF($B$1:$D$3;$A$1:$A$10));ROW($A$1:$A$10)-ROW($A$1)+1;"");ROW(A1)))

creating a macro to separate data [closed]

Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Closed 8 years ago.
This question appears to be off-topic because it lacks sufficient information to diagnose the problem. Describe your problem in more detail or include a minimal example in the question itself.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Improve this question
HI I am new to using excel and only have a basic knowledge in designing macros. I want to be able to design a macro that can separate different invoice details depending on the company unique id into a separate sheet. only problem there is two or three rows that need to be moved together. How would I go about doing this?
For example:
Here is a sample picture of the data. what i want to do is copy the H and N in rows 1 and 2 deepening on the value in row D
Assuming your testing for something like 'is value > 25'
Sub Macro1()
Dim dat As Variant
Dim rng As Range
Dim i As Long
Dim cntr As Integer
cntr = 1
Set rng = [A1:A5]
dat = rng ' dat is now array (1 to 5, 1 to 1)
For i = LBound(dat, 1) To UBound(dat, 1)
If rng(i, 1).Offset(0, 3).Value > 25 Then
Sheets("Sheet2").Range("A" & cntr).Value = Range("A" & i).Value
cntr = cntr + 1
End If
Next
End Sub

Resources