I am trying to write a VBA Script to format a list of several thousdand phone numbers I have stored in an excel spread sheet. So far I have this, but when I run it it doesn't format the phone number. It does add the value NULL if the cell is empty but doesnt format the number anyone see what I am doing wrong?
Sub CheckPhoneNumber()
Dim retNumber As String
Range("K3").Activate
Do Until ActiveCell.Row = 3746
If ActiveCell.Value = "" Then
ActiveCell.Value = "NULL"
Else
For i = 1 To Len(ActiveCell.Value)
If Asc(Mid(ActiveCell.Value, i, 1)) >= Asc("0") And Asc(Mid(ActiveCell.Value, i, 1)) <= Asc("9") Then
retNumber = retNumber + Mid(ActiveCell.Value, i, 1)
End If
Next
If Len(retNumber) > 10 Then
cleanPhoneNumber = Format(retNumber, "(+#) 000-000-0000")
Else
cleanPhoneNumber = Format(retNumber, "000-000-0000")
End If
End If
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Looks like you forgot to write cleanPhoneNumber back to the sheet? you need an ActiveCell.Value = cleanPhoneNumber before the final end if.
Related
Beyond ordinary Latin characters, Excel somehow does a pretty good job of sorting strings in various alphabets.
< and > in formulae use that same order.
But < and > in VBA use a different order - probably given by Unicode().
The extract below shows the inconsistency between columns B and C.
How can I compare strings in VBA using the same order that is used for sorting?
I am hoping that while X < Y will not give the relevant result, somefunction(X) < somefunction(Y) will do so.
I have found some articles/postings about how to change the sort order, but that is not the issue here.
Apologies for the above being an image - I can't work out how to get Excel data in to SO.
For replication:
The values in column A are: А Б В Г Ґ Д Е Є Ж З И Stop, starting from A2, which is named "first"
The formula in B2 is =IF(A2<A3,"Less than next","Greater than next")
The formula in D2 is =UNICODE(A2)
Column C is populated by the macro:
Sub Compare()
Range("first").Select
Do Until ActiveCell.Value = "Stop"
If ActiveCell.Value < ActiveCell.Offset(1, 0).Value Then
ActiveCell.Offset(0, 2).Value = "Less than next"
ElseIf ActiveCell.Value > ActiveCell.Offset(1, 0).Value Then
ActiveCell.Offset(0, 2).Value = "Greater than next"
Else
ActiveCell.Offset(0, 2).Value = "Same as next"
End If
ActiveCell.Offset(1).Select
Loop
End Sub
You can force VBA to use a different comparison method when comparing strings.
This can be done for a whole module, putting Option Compare Text at the top of the code - if done, you can use the regular comparison operators like < to > without changing your code (Default setting is Option Compare Binary)
You can also do this indiviually for a single comparison using the function strComp and pass vbTextCompare as third parameter (omitting tge third parameter will let VBA fall back to the defined Option Compare)
StrComp(cell.Value, cell.Offset(1, 0).Value, vbTextCompare)
Note that the text sorting option also will see upper and lower case characters as "equal".
Not 100% sure if those will always get the same results as the Excel compare, but at least for your given examples it did. If you don't trust this, you can fall back to the Evaluate-method that really uses the Excel-engine.
Option Compare Text
Sub Compare()
Dim cell As Range
Set cell = ThisWorkbook.Sheets(1).Range("A2")
Do Until cell.Value = "Stop"
Dim formula As String, res As Variant
formula = """" & cell.Value & """ < """ & cell.Offset(1, 0).Value & """"
res = Application.Evaluate(formula)
cell.Offset(0, 1) = getCmpInfostr(res)
cell.Offset(0, 2) = getCmpInfostr(cell.Value < cell.Offset(1, 0).Value)
cell.Offset(0, 3) = getCmpInfostr(StrComp(cell.Value, cell.Offset(1, 0).Value))
cell.Offset(0, 4) = getCmpInfostr(StrComp(cell.Value, cell.Offset(1, 0).Value, vbTextCompare))
Set cell = cell.Offset(1, 0)
Loop
End Sub
Function getCmpInfoString(c As Variant)
If VarType(c) = vbBoolean Then
c = IIf(c, -1, 1)
End If
If VarType(c) <> vbInteger And VarType(c) <> vbLong Then
getCmpInfostr = "invalid"
ElseIf c < 0 Then
getCmpInfostr = "Less than"
ElseIf c > 0 Then
getCmpInfostr = "Greater than"
Else
getCmpInfostr = "Same"
End If
End Function
Obligatory hint for all VBA programming: avoid Select and ActiveCell - see How to avoid using Select in Excel VBA
The following code shows the different methods - let the code run once with and once without the Option Compare Text option.
Hey I have been writing some code to add a part ID to a spreadsheet off of a user form in Excel VBA. I have been reading through different documentation and can not figure out why no matter what type of method of inserting a row I try it inserts a row with a repeating value instead of a blank one. If anyone knows how to specify blank, other than writing the whole row to blank and then writing my numbers I want after, that would be appreciated.
I have tried both the following lines to add a row
Cells (x+1 ,column).EntireRow.Insert Shift:= xlDown
ws1.Rows(x+1).Insert Shift:=xlDown
This is the function it is used in:
Public Sub Add(IDRange As Range)
SearchCell = Cells(x, IDRange.Column)
Cells(x, IDRange.Column).Select
Do
If SearchCell = PartID Then
MsgBox " this Company Already uses this part"
Exit Sub
ElseIf x <> StopRow Then
x = x + 1
SearchCell = Cells(x, IDRange.Column)
End If
Loop While x <> StopRow And SearchCell <> PartID
Cells(x + 1, IDRange.Column).EntireRow.Insert Shift:=xlDown
Cells(x, IDRange.Column).Value = PartID
MsgBox PartID & " has been added to Adress " & Cells(x, IDRange.Column).Address
Cells(x, IDRange.Column).Select
End Sub
Bellow is the function that calls the Add Function and where I belive it may be getting the company name from
Private Sub AddPart_Click()
AddPartCounter = 0
Company = UserForm1.CompanyBox.Value
PartID = UserForm1.PartBox.Value
If Company = "" Then
MsgBox " Please put in the company you would like the part to go under"
ElseIf PartID = "" Then
MsgBox " Please put in the Part you would like entered"
ElseIf UserForm1.Studs.Value = False And UserForm1.Spreaders.Value = False And UserForm1.Blocks.Value = False And UserForm1.Imma.Value = False Then
MsgBox "Please select the type of part you are trying to add"
Else
Dim CurrentCell
Set CurrentCell = Cells.Find(What:=Company, LookAt:=xlWhole)
If CurrentCell Is Nothing Then
MsgBox " Company Not Found "
Exit Sub
End If
x = CurrentCell.Row
Do
Set CurrentCell = CurrentCell.Offset(1, 0)
Loop While CurrentCell.Offset(1, 0) = "" And Not CurrentCell Is Nothing And CurrentCell.Offset(1, 0).Row <> thisvar.Row + 1
StopRow = CurrentCell.Row
'If they are trying to add a nut
If UserForm1.Imma.Value = True Then
Call Add(Nut_ID_Rng)
'IF they are trying to add a stud
ElseIf UserForm1.Studs.Value = True Then
Call Add(Stud_ID_Rng)
'If they are trying to add a block
ElseIf UserForm1.Blocks.Value = True Then
Call Add(Block_ID_Rng)
'If they are trying to add a spreader
ElseIf UserForm1.Spreaders.Value = True Then
Call Add(Spreader_ID_Rng)
End If
End If
AddPartCounter = 1
End Sub
I know that the repeating pattern is coming from the insert line through debugging but I can not figure out why I have tried changing variables to numbers and it still did the same thing. This what it looks like with the repeating values.
enter image description here
The problem is that you most likely have a value still stored in your clipboard when you execute the Macro. To fix that, simply add this line of dode before running the insert line:
Applcation.CutCopyMode = False
That will clear your clipboard and allow the inserted rows to be blank.
I have an Excel VBA procedure which is supposed to compare the values of two cells. In my case they are scalars, ranging from 1 to 3. Basically, they are answers to questions. If they match, then I want to color a certain cell green, otherwise I want to make it red. Is there something wrong with my syntax?
Sub CheckBold()
'
' CheckBold Macro
'
'
Row = ActiveCell.Row
If ThisWorkbook.Sheets(1).Range("D" & CStr(ActiveCell.Row)).Font.Bold Then
ActiveCell.Value = 1
End If
If ThisWorkbook.Sheets(1).Range("E" & CStr(ActiveCell.Row)).Font.Bold Then
ActiveCell.Value = 2
End If
If ThisWorkbook.Sheets(1).Range("F" & CStr(ActiveCell.Row)).Font.Bold Then
ActiveCell.Value = 3
End If
ActiveCell.Value = ThisWorkbook.Sheets(3).Range("A" & CStr(ActiveCell.Row)).Value & ActiveCell.Value
If CInt(ActiveCell.Value) = CInt(ThisWorkbook.Sheets(3).Range("A" & CStr(ActiveCell.Row)).Value) Then
ActiveCell.Interior.Color = RGB(0, 180, 0)
Else
ActiveCell.Interior.Color = RGB(180, 0, 0)
End If
End Sub
What happens is that always the code goes on the Then branch of the if, even though the values are different. Why do I get this behavior?
I´m having problems with my code
I want this code to copy cells from one sheet to another but with the following trick
(english is not my first language, Sorry )
In "sheet1" there is "date and ticket number" always in the same cell, but I also want to copy a list of values that can change in amount...(A10)
all these values go to "sheet2" in the same row...
"date1" "ticket123" "itemA" "amount"
"date1" "ticket123" "itemB" "amount2"
Private Sub CommandButton1_Click()
filalibre = Sheets("sheet2").Range("a1048576").End(xlUp).Row + 1
ActiveSheet.Range("a10").Select
fila = 10
While ActiveCell.Value <> ""
Sheets("sheet2").Cells(filalibre, 1) = ActiveSheet.Range("E4")
Sheets("sheet2").Cells(filalibre, 2) = ActiveSheet.Range("E2")
Sheets("sheet2").Cells(filalibre, 3) = ActiveSheet.Offset(0, 0)
Sheets("sheet2").Cells(filalibre, 4) = ActiveSheet.Offset(0, 1)
filalibre = filalibre + 1
ActiveCell.Offset(1, 0).Select
Wend
Call limpieza
End Sub
What can I read to fix this... or can anyone help me
Since you have not mentioned the exact problem or the error you see, I can see some possible sources of an issue.
Replace
Sheets("sheet2").Cells(filalibre, 3) = ActiveSheet.Offset(0, 0)
Sheets("sheet2").Cells(filalibre, 4) = ActiveSheet.Offset(0, 1)
By
Sheets("sheet2").Cells(filalibre, 3) = ActiveCell.Offset(0, 0)
Sheets("sheet2").Cells(filalibre, 4) = ActiveCell.Offset(0, 1)
Besides this,there are a few other improvements that can be done to your code. But first try to get it working without an error.
In the following picture of an Excel sheet, the heading of the first column, and then of every 7th column after that, contains a month and a year.
I am trying to think of some code which would make entering complete dates under these headings faster. Since the month and the year are already present, I'm thinking there must be a way to enter just the day, and get the whole thing. For example, if "21" were entered in cell A26, "2/21/2015" would result.
Anyone have an idea for how I might get this output?
Edit: Thanks to the helpful replies on this forum, I figured out exactly how to do this. Here is the code for my finished product, in case anyone wants to do something similar:
Private Sub Worksheet_change(ByVal Selection As Range)
Set Sel = Selection
If Sel.Count > 1 Then
Exit Sub
End If
If (Sel.Column - 1) Mod 7 = 0 Or Sel.Column = 1 Then
'In my case, date columns always follow the pattern of 1, 8, 15...
If Sel.Value > 31 Or Sel.Value = "" Then
Exit Sub
Else
Sel.NumberFormat = "General"
Sel.Value = Left(Cells(1, Sel.Column), InStr(Cells(1, Sel.Column), ",") - 1) & " " & _
Sel.Value & Right(Cells(1, Sel.Column), 6)
Selection.NumberFormat = "m/d/yyyy"
End If
End If
End Sub
How about entering the day numbers, selecting the range where these day numbers are entered, and running the below:
Sub Add_month_year()
Dim c As Range
For Each c In Selection
c = Left(Cells(1, c.Column), InStr(Cells(1, c.Column), ",") - 1) & " " & _
c.Value & Right(Cells(1, c.Column), 6)
Next
End Sub
This should return the full dates in date code, which you can then format as you see fit.