I'm trying to delete the spaces that I have in each field of the column "A" this spaces are at the end of the string some of the string has 3 spaces others 4. When I run the code, I don't have error, so I think I have a bug because nothing happened when is running.
Dim result As String
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Right(Cells(i, "A").Value, 4)) Like " " Or (Right(Cells(i, "A").Value, 3)) Like " " Then
result = Replace(Cells(i, "A"), " ", "")
End If
Next i
In your specific case, the problem is that you're storing the replacement value in a string variable named result, then doing nothing with it. If you want it to be in the Cell, you have to add it back in there, such as:
Cells(I, "A").Value = result
Keep in mind, there is an Application.Trim method that can actually save a bit of time over looping. Experiment with code such as:
Dim rng as Range
set rng = Range("A1:A10")
rng.Value = Application.Trim(rng)
Currently you are not actually updating the cell in the loop, you just;
result = Replace(Cells(i, "A"), " ", "")
You should:
Cells(i, "A") = Replace(Cells(i, "A"), " ", "")
Or better
Cells(i, "A") = rtrim$(Cells(i, "A"))
Which will remove all right spaces. You can probably remove the if check as well.
What are expecting this code to do? as currently the values are being read into result. It would also be better to use trim to remove trailing spaces.
Dim result As String
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 1 Step -1
result = RTrim(Cells(i, "A"))
Next i
Related
I have been trying this for quite sometime and although I get the correct answer but I get an Application-defined or Object defined error.
I have two sheets: Sheet2 and Sheet3. Both the sheets have a column "url". What I want is to get the row number of the url in Sheet2 and get the urls row position printed in
Column C ("Match Row") of Sheet3.
This is the example of the data I am working on.
I get the error in this line
Matchvalue.Formula = "=Match(Worksheets("Sheet3").Cells(i, 2), Worksheets("Sheet2").Range("B:B"), 0)
This is what I've tried:
Dim i As Integer
i = 2
Do While Worksheets("Sheet3").Cells(i, 2) <> ""
Worksheets("Sheet3").Cells(i, 14) =
WorksheetFunction.Match(Worksheets("Sheet3").Cells(i, 2),
Worksheets("Sheet2").Range("B:B"), 0)
i = i + 1
Loop
Try the code below, explanations inside the code's comments:
Option Explicit
Sub MatchUrl()
Dim i As Long
Dim MatchRng As Range
With Worksheets("Sheet2")
' set the match range is "Sheet2"
Set MatchRng = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
End With
With Worksheets("Sheet3")
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
' check if successful match
If Not IsError(Application.Match(.Cells(i, 2), MatchRng, 0)) Then
.Cells(i, 2) = Application.Match(.Cells(i, 2), MatchRng, 0)
Else ' Match failed, raise some kind of error
.Cells(i, 2) = "Url not found in Sheet2!"
End If
Next i
End With
End Sub
i don't use Match so I don't know the Signature of it but :
By escaping Quotes perhaps ... like
Matchvalue.Formula = "=Match(" & Worksheets("Sheet3").Cells(i, 2) & ";B:B;0)"
To escape quotes just double them.
for example Debug.print "Hey ""You"" how are you ?"
Sorry I am new to VBA. The Vlookup calls for Column X & Y work fine. However, for column Z, I am trying to count the number of names in Column B, but an error kept popping up. I wonder why?
Dim lastrow As Long
lastrow = Range("A2").End(xlDown).Row
Range("X2:X" & lastrow).FormulaR1C1 = "=VLOOKUP(RC[-23],'Sheet2'!R1C1:R25000C10,7,0)"
Range("Y2:Y" & lastrow).FormulaR1C1 = "=VLOOKUP(RC[-24],'Sheet2'!R1C1:R25000C10,2,0)"
Range("Z2:Z" & lastrow).FormulaR1C1 = "=LEN(RC[-22]-LEN(SUBSTITUTE(RC[-22], "";"", ""))+1"
Columns("X:Z").EntireColumn.AutoFit
Basically, what I am try to achieve is like the following. Column Z will autofill the occurrences of names in column B
I think you are missing a parenthese in your function string, as well as escape quotes for the empty string, so it should be:
Range("Z2:Z" & lastrow).FormulaR1C1 = "=LEN(RC[-22])-LEN(SUBSTITUTE(RC[-22], "";"", """"))+1"
I realize that this answer doesn't answer your question but at least the following code serve the same purpose. And to fix the problem if there are blanks or merged cells in the range as pointed out by Mr. RGA, I change the way to formulate variable Last_Row
Sub Count_Name()
Dim i As Long, Last_Row As Long
With Sheets("Sheet1")
'It won't be a problem anymore if there are blanks or merged cells in the range using this line
Last_Row = Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To Last_Row
If .Cells(i, "A") = "" Then
.Cells(i, "B") = 0
Else
.Cells(i, "B") = Len(.Cells(i, "A")) - Len(Replace(.Cells(i, "A"), ";", "")) + 1
End If
Next i
End With
End Sub
Here I'm assuming the string names are in column A, the number of names are in column B, and both of the data are in Sheet1. The equivalent Excel formula for the above code is
=LEN(A2) - LEN(SUBSTITUTE(A2, ";", "")) + 1
I'm trying to make a function to do the following:
Cycle through all my datasets in my sheet
Cycle through each column in my datasets
Look at the title for that column and check if it is in my list.
Find find a few various other columns, but this time using .Find
Now cycle through each row in the column for that specific dataset
Use the column references found in point 4 and the row from point 5 to put the cell's into a variable that will be used on step 7 which is to insert a formatted comment in the originally found column (for that row).
I've tried getting some code working from what I found on a different site but I can't get it working correct, I'm stuck at part 5.
A data example could look like:
My attempted code looks like:
Sub ComTest()
COMLIST = ";Cond;"
Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each a In rng.SpecialCells(xlCellTypeConstants).Areas
With a.CurrentRegion
Set r = .Rows(1)
For j = 1 To r.Columns.Count
TitleCell = r.Cells(j).Address
v = ";" & Range(TitleCell).Value & ";"
'-----------------------------------------------------------------------------------------
If InStr(1, COMLIST, v) Then
On Error Resume Next
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Condw = r.Columns.Find(Replace(v, ";", "") & " " & "w", lookAt:=xlWhole).Column
Condw = .Cells(r, Condw).Address
' Add more stuff here
End If
'-----------------------------------------------------------------------------------------
Next j
End With
Next a
End Sub
As for part 7, the output would essentially be as follows for "row 1" but this part I should be able to do, it's the looping part that I am struggling with.
This question raises a few points that this answer might resolve for you and others in the future:
I note that not many of your previous questions have accepted answers, and that several of them present answers but you have needed to respond by saying it doesn't suit your needs for a certain reason. It suggests you aren't really providing the right details in your question. I think that's the case here. Perhaps you could outline the outcome you are trying to achieve and, especially for Excel VBA, the precise structure of your spreadsheet data. It's tempting to think in this question that you simply want to know how to take the values of Columns C to F and write them to a comment in Column B for any row that contains data.
Using web code can often take more time to understand and adapt than learning the code syntax from first principles. Your provided code is difficult to follow and some parts seem odd. I wonder, for example, what this snippet is meant to do:
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Using Option Explicit at the top of your module (which forces you to declare your variables) makes VBA coding and debugging much easier, and code submitted on SO is easier to follow if we can see what data types you meant variables to hold.
If your question is merely "How do I take the values of Columns C to F and write them to the cell in Column B for any row that contains data?", then your code could be as simple as:
Dim condCol As Range
Dim cell As Range
Dim line1 As String
Dim line2 As String
Dim cmt As Comment
'Define the "Cond" column range
'Note: this is an unreliable method but we'll use it here for the sake of brevity
Set condCol = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns("B")
'Delete any comment boxes
condCol.ClearComments
'Loop through the cells in the column and process the data if it's a number
For Each cell In condCol.Rows
If Not IsEmpty(cell.Value) And IsNumeric(cell.Value) Then
'Acquire the comment data
line1 = "Cond: " & cell.Offset(, 1).Value & "/" & cell.Offset(, 2).Value & _
" (" & Format(cell.Offset(, 3), "0.00%") & ")"
line2 = "Cond pl: $" & cell.Offset(, 4).Value
Set cmt = cell.AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
End If
Next
If, on the other hand, your question is that you have unreliable data on your spreadsheet and your only certainty is that the headings exist on any one row, then some form of search routine must be added. In that case your code could look like this:
Dim rng As Range
Dim rowRng As Range
Dim cell As Range
Dim condCol(0 To 4) As Long
Dim line1 As String
Dim line2 As String
Dim allHdgsFound As Boolean
Dim i As Integer
Dim cmt As Comment
Set rng = ThisWorkbook.Worksheets("Sheet1").UsedRange
rng.ClearComments
For Each rowRng In rng.Rows
If Not allHdgsFound Then
'If we haven't found the headings,
'loop through the row cells to try and find them
For Each cell In rowRng.Cells
Select Case cell.Value
Case Is = "Cond": condCol(0) = cell.Column
Case Is = "Cond w": condCol(1) = cell.Column
Case Is = "Cond r": condCol(2) = cell.Column
Case Is = "Cond %": condCol(3) = cell.Column
Case Is = "Cond wpl": condCol(4) = cell.Column
End Select
Next
'Check if we have all the headings
'by verifying the condCol array has no 0s
allHdgsFound = True
For i = 0 To 4
If condCol(i) = 0 Then
allHdgsFound = False
Exit For
End If
Next
Else
If Not IsEmpty(rowRng.Cells(1).Value) Then
'The cell has values so populate the comment strings
line1 = "Cond: " & rowRng.Columns(condCol(1)).Value & "/" & _
rowRng.Columns(condCol(2)).Value & _
" (" & Format(rowRng.Columns(condCol(3)).Value, "0.00%") & ")"
line2 = "Cond pl: $" & rowRng.Columns(condCol(4))
Set cmt = rowRng.Columns(condCol(0)).AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
Else
'We've reached a blank cell so re-set the found values
allHdgsFound = False
Erase condCol
End If
End If
Next
Of course your data might be structured in any number of other ways, but we don't know that. My point is that if you can be more specific in your question and provide an outcome you are trying to achieve, you are likely to receive answers that are more useful to you.
Sub BatchCopyTextNewColumn()
Dim LastRow As Integer
'Variables declared as per Solution from http://stackoverflow.com/questions/24967189 /vba-'decimal-issue-after-replacing-a-hyphen-with-dot
'by Jagadish Dabbiru (July 25, 2014)
Dim i As Integer
Dim BatchNo() As String
Dim ArrBatchNo As Long
Worksheets("DataFile").Activate
Cells(1, 17).Select
'Rename Columns
Cells(1, 17).Value = "BatchNumeric"
Cells(1, 18).Select
'Rename Columns
Cells(1, 18).Value = "BatchCheck_Old_New"
'Ask user to provide you with the Batch# from the last data set e.g. which was received a week ago.
'Last Row is defined by the Column 1 "AccountString"
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Range("O2", Range("O1").End(xlDown))
.Copy
End With
'Use the PasteSpecial method:
Range("Q2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Solution from http://stackoverflow.com/questions/24967189/vba-decimal-issue-after-'replacing-a-hyphen-with-dot
'by Jagadish Dabbiru (July 25, 2014)
'Take each value from column q and Split the batch code with delimiter hyphen(-).
'Then check the length of the value of 2nd array element.
'If length is 1 digit then add 0 as prefix else keep as it is.
i = 1
Do
BatchNo = Worksheets("DataFile").Range("Q" & i).Value
ArrBatchNo = Split(BatchNo, "-")
If Len(ArrBatchNo(1)) = 1 Then
ArrBatchNo = "0" & ArrBatchNo
End If
Worksheets("DataFile").Range("Q" & i).Value = ArrBatchNo(0) & "." & ArrBatchNo(1)
i = i + 1
Loop While Worksheets("DataFile").Range("Q" & i).Value <> ""
Range("Q2").Activate
End Sub
There is a problem with decimals after replacing hyphens with dots.
Originally the Batch numbers are issued with hyphens. I need to use them as values as I have to distinguish between "OLD" Batch numbers (sent previously) and "NEW" (larger than the last Batch number).
Hyphen replacement (my code):
Sub ReplaceBatchCharacter()
Range("Q2").Activate
Worksheets("DataFile").Columns("Q").Replace _
'I tried to replace it with "." and there is a problem with decimals as well (e.g. batch # 4230-1 and 4230-10 are both shown as 4210.10 after replacement
What:="-", Replacement:=".0", _
'by replacing with ".0" I have solution for batch #'s xxxx-1/2/3/4/5/6/7/8/9 but when it starts with double digits xxxx-10 etc I have similar problem as they become xxxx.010 etc.
So the batch number 4230-1 and 4230-10 are both shown as 4210.010 after replacement.
SearchOrder:=xlByColumns, MatchCase:=True
End Sub
Check Old and New Batch # (my code):
Sub BatchNumberCheckNewOld()
Dim BatchNumberPrevious As Single
Dim BatchNumberCurrentCell As Range
Dim BatchNumberCurrentRange As Range
Dim BatchNumberCurrentResult As String
Dim LastRow As Long
'Dim ChangedRange As Range
Worksheets("DataFile").Activate
Range("Q2").Activate
LastRow = Cells(Rows.Count, 17).End(xlUp).Row
'Ask user to provide us with the Batch# from the last data set e.g. which was received a week ago.
'Last Row is defined by the Column 1 "AccountString"
'BatchNumberPrevious = 4250.1
BatchNumberPrevious = InputBox("Please enter the last Batch # from previous period. Don't forget to reconcile TB's (prior and current months). Ocassionally OLD batches could be NEW.")
Set BatchNumberCurrentRange = Range(Cells(2, 17), Cells(LastRow, 17))
For Each BatchNumberCurrentCell In BatchNumberCurrentRange
If BatchNumberPrevious >= BatchNumberCurrentCell.Value Then
BatchNumberCurrentResult = "Old"
Else
BatchNumberCurrentResult = "New"
End If
'BatchNumberCurrentResult column should be populated by offsetting BatchNumberCurrentCell variable
BatchNumberCurrentCell.Offset(0, 1).Value = BatchNumberCurrentResult
Next BatchNumberCurrentCell
'Autofit width of columns
ActiveSheet.UsedRange.Columns.AutoFit
End Sub
Take each value from column q and Split the batch code with delimiter hyphen(-). Then check the length of the value of 2nd array element. If length is 1 digit then add 0 as prefix else keep as it is.
i =1
Do
BatchNo = Worksheets("DataFile").Range("Q"& i).Value
ArrBatchNo = Split(BatchNo,"-")
If Len(ArrBatchNo(1)) = 1 Then
ArrBatchNo(1) = "0" & ArrBatchNo (1)
End If
Worksheets("DataFile").Range("Q"& i).Value = ArrBatchNo(0) & "." & ArrBatchNo(1)
i = i+1
Loop While Worksheets("DataFile").Range("Q"& i).Value <> ""
I can't seem to find a way to save leading zeros in my VBA code. The zeros are necessary since they correspond to unique IDs.
I've tried changing the number format to text and 0000.... in excel and the same approach in my actual code:
ActiveSheet.Cells(i, j).NumberFormat = "00000"
Any other suggestions? (If I manually type these numbers into VBE it strips the leading zeros too).
EDIT:
Sheets.Add.Name = "Temp"
Sheets("Sheet1").Select
ActiveSheet.Cells(2, 2).NumberFormat = "000"
cid = Cells(2, 2)
MsgBox cid
Sheets("Sheet2").Select
ActiveSheet.Cells(6, 1).NumberFormat = "00000"
sid = Cells(6, 1)
Sheets("Temp").Select
Url = _
"URL;" & _
"http......asp?" & _
"X1=" & cid & "&" & _
"X2=" & sid & "&"
This is inside a loop ultimately but I'm debugging as individual iterations.
All below deliberations were about writing to a cell, not reading from it. Changing the Numberformat doesn't work that way.
See if you can figure out how this code works:
dim v as integer
v = val(Sheets("Sheet1").Cells(2, 2))
dim cid as string
cid = format(v, "000")
You should never use Select and ActiveSheet that way, it is not necessary; and never use Cells without the sheet it should be referring to.
(Val can be omitted if the cell is really already numeric and not text).
Earlier answer... :
This code works perfectly fine for me
Worksheets(1).Columns("A").NumberFormat = "#"
Worksheets(1).Cells(1, "A").Value = "00023"
And also does
Worksheets(1).Columns("A").NumberFormat = "000000"
Worksheets(1).Cells(1, "A").Value = "0023"
(Here the string is converted to a number and displayed with 6 digits)
EDIT:
If that fails - although I could not explain that - I'd still bet that the ' should really work:
(No numberformat required.)
Dim s As String
s = "0002"
Worksheets(1).Cells(1, "A").Value = "'" & s
Setting the format to text or "00000" should work. The small snippet below gives the results expected. With the first storing a value of 0001 and the second storing a value of 1 that is formatted to look like 0001.
This also works if the cell value was stored in a string variable.
Sub set_value()
Range("A1").NumberFormat = "#"
Range("A1").Value2 = "0001"
Range("B1").NumberFormat = "0000"
Range("B1").Value2 = "1"
End Sub