I have an Excel file with 3 columns, the first 2 were concatenated into the 3rd one.
Then I ran this VBA in order to make the empty cells equal to the above populated cell.
Sub fillempty()
With Selection.SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub
Saying that there are no empty cells, despite being visible empty. So if I take the so called non-empty cells but visible empty and clear content and run the VBA again, it does populate.
The problem arises because I have hundreds of thousands of values.
If I run the VBA independently for 1st or 2nd column works, but not for the Concatenated one.
It appears that some cells are empty with the naked eye, but unless their content is cleared the script won't work...
C2 = IF(A2 <> "", CONCATENATE(A2, B2), "") then dragged it down for hundreds of thousands of values
Any help would be more than appreciated.
Thanks
Dim c As Range
For Each c in Selection.Cells
if Len(Trim(c.value))=0 Then c.value=c.offset(-1,0).value
Next c
or faster as long as you don't need to preserve any formulas:
Dim r as long, c as long, data, cols as long
data = selection.value
cols = ubound(data, 2)
for r=2 to ubound(data, 1)
for c = 1 to cols
if Len(Trim(data(r, c))) = 0 Then data(r, c) = data(r-1, c)
next c
next r
selection.Value = data
The isEmpty() function is handy, too. It returns FALSE if there's a formula in it (but the cell is clear). Looks like this:
Sub IsA1ReallyEmpty()
If IsEmpty(Range("A1").Value) = True Then
MsgBox "Yep, A1 is empty."
Else
MsgBox "Nope, it has stuff in it."
End If
End Sub
Related
I have this function which manages to remove all numbers stored as text:
Public Function find_numbers_formated_as_text(ByVal sh As Worksheet)
Dim c As Range
On Error GoTo A
''''For Each r In sh.UsedRange.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
For Each c In sh.ListObjects(1).DataBodyRange
''''For Each c In sh.UsedRange.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
''''For Each c In sh.ListObjects(1).DataBodyRange.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
If IsNumeric(c.Value) = True Then
c.Value = c.Value
End If
Next c
Exit Function
A:
On Error GoTo 0
End Function
But it is really slow... Does anyone have any suggestion on how to make it faster?
I did try some other things which is why there are some of the comments in the source code. But comments didn't work, because range was also empty in my case (even if table was full of data).
Please, replace this part of your code:
For Each C In sh.ListObjects(1).DataBodyRange
''''For Each c In sh.UsedRange.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
''''For Each c In sh.ListObjects(1).DataBodyRange.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
If IsNumeric(C.Value) = True Then
C.Value = C.Value
End If
Next C
with this one:
Dim lRng As Range, arr, i As Long, j As Long
Set lRng = sh.ListObjects(1).DataBodyRange
arr = lRng.Value2
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If IsNumeric(arr(i, j)) Then arr(i, j) = CDbl(arr(i, j))
Next j
Next i
With lRng
.NumberFormat = "General"
.Value2 = arr
End With
It places the range in an array and all process take place only in memory, the modified array content being dropped at the end of the code, at once.
The most time consuming is the iteration between each cell and writing cell bay cell...
If "General" formatting may bother your list object format, please state in which columns the conversion should be done, and I will adapt the code to format only the respective table columns.
Now I could see one of your comments saying that in the range to be processed exist (and must remain) formulas. The above code does not deal with such a situation. You should state it in your question, I think...
Edited:
If the formulas used to return a numeric value (not a string) and, by mistake the respective range has been formatted as Text, you can try the next way (to maintain the formulas):
With sh.ListObjects(1).DataBodyRange
.NumberFormat = "General"
.Formula = .Formula
End With
There are lots of answers to this question. This is a simple thing to try. Add this before:
Application.Calculation = xlManual
and this after:
Application.Calculation = xlAutomatic
It's faster to store the range as array than changing values in the sheet.
sh.ListObjects(1).DataBodyRange.formula = sh.ListObjects(1).DataBodyRange.formula
The numbers will default to numbers if they were text so you don't need to test if it's number.
(You will not lose formulas using this method.)
i have a list of names(Column A), the numbers in columns B to F are result of a formula. I'm trying to create a FOR LOOP code that will check columns B to F, if all cells in B to F are zero then the code should ignore the current row and skip to the next row; if any of the cells in columns B to F is greater than 0, then the code should get the corresponding name in Column A.
Example: If any of the cells in B2, C2, D2, and E2 is greater than 1, then i should get the name/value of A2. if all cells in B2, C2. D2, and E2 are all zeros, then proceed to check next row and do the same thing.
here's the code i used to try to get the names that has any of the 4 column cell values greater than 1
For i = 2 To LastCalcAnalystRowIndex '//wsCalculations.Cells(Rows.Count, "CP").End(xlUp).Row
'//Get Component from cell in column "BP"
Analyst = wsCalculations.Cells(i, "CP").Value
Component = wsCalculations.Cells(i, "CN").Value
weeknumber = wsCalculations.Range("BR2").Value + 3
If wsCalculations.Cells(i, "B").Value = 0 And wsCalculations.Cells(, "C").Value = 0 _
And wsCalculations.Cells(i, "D").Value = 0 And wsCalculations.Cells(i, "E").Value = 0 _
And wsCalculations.Cells(i, "F").Value = 0 Then
Exit For
Else
wsCalculations.Cells(i, "A").Value = wsCalculations.Cells(i, "CP").Value
End If
Next
using the code above, i tried to get the names which all 4 column values are not equal to zero, but the result i get is just a copy of the original list. i highlighted the rows i want my code to skip. i also included the result i get and the result i want to get.
Below is a sample data. My original data has 54 rows. .
can anyone please tell me what im getting wrong?
There's no real need for VBA.
Note that I have used a Table with structured references. You can change it to a range with normal references if you prefer.
If you have O365, you can use a helper column and a formula.
Add a helper column which SUM's the cells in each row (and you can hide that column if necessary).
eg: G2: =SUM(Table3[#[Column2]:[Column6]])
Then, assuming the data is in a Table named Table3 use the formula:
=INDEX(FILTER(Table3,Table3[sumRow]>0),0,1)
If you have an earlier version of Excel, you can use:
I2: =IFERROR(INDEX(Table3[Column1],AGGREGATE(15,6,1/(Table3[sumRow]>0)*ROW(Table3)-ROW(Table3[#Headers]),ROWS($1:1))),"")
and fill down the length of the table.
Not the solution but could shorten your initial code
Why not create a hidden column* that does an =SUM of the entire row
Then get the value from that
instead of using code to get the value of each 5 cells then adding it up.
edit: changed the 'hidden cell' to 'hidden column' :P
Try
Sub test()
Dim rngDB As Range
Dim rng As Range, rngSum As Range
Dim wsCalculations As Worksheet
Dim vR() As Variant
Dim n As Long
Set wsCalculations = ActiveSheet
With wsCalculations
Set rngDB = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
End With
For Each rng In rngDB
Set rngSum = rng.Offset(, 1).Resize(1, 5)
If WorksheetFunction.Sum(rngSum) > 0 Then
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = rng
End If
Next rng
With wsCalculations
If n Then
.Range("h2").Resize(n) = WorksheetFunction.Transpose(vR)
End If
End With
End Sub
can anyone please tell me what im getting wrong?
actually your shown code isn't consistent with your wording, so it's impossibile to tell all that's wrong
but for sure that Exit For is a logical error, since it actually gets you out of the loop when it first meets five zeros
so as far as this logical error is concerned, you should change that piece fo code to the following:
With wsCalculations
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(.Cells(i, 2).Resize(, 5), 0) < 5 Then ' when a row is eligible for math
' do your math
End If
Next
End With
where I used WorksheetFunction.CountIf() function that enables you to deal with different conditions since your wording wasn't clear about this item, too ("greater than 0", "all cells...are zero", "greater than 1")
Background:
As part of a project I am working on which involves fuzzy string matching, I have implemented the Levenshtein Distance algorithm in VBA to calculate the "similarity" between two strings (see this question for part of the code/more insight into my project).
So, I created a table in Sheet1 in Excel with row and column headers which are strings (located in cells A2:A2146 and B1:TU1, respectively), and I am comparing these strings with the LevenshteinDistance function. The function populates the empty cells in the table (in my case, B2:TU2146) with what I call the matchScore. The idea is this: the more similar two strings are, the lower their matchScore. It follows that if two strings match exactly, we would have matchScore = 0.
(1) More specifically, suppose the value of S1 (one of my column headers) is "recursion" and the value of cell A532(one of my row headers) is "recursion". After executing my "similarity" function, the value returned in cell S532 of the table is 0.
What I want to achieve:
For the purposes of my problem and the heuristic I've defined to measure string similarity, I am particularly interested in string pairs for which matchScore <= 1 is true (this includes the example (1) above).
The data table is huge, and it is difficult for me to get visibility into the "good data" (matchScore <= 1). Thus, I want Excel to find each value in the table which is <=1 and output them in Sheet2 along with the strings that were paired off as "good matches." Therefore, there should be three columns of data in Sheet2. To reference again the example above (1), when my code finishes running, I should see 0, "recursion", and "recursion" in cells A1 through C1 (assuming this was the only "good match" I found in the table).
What I have tried to implement as a solution:
Sub FindMatches()
Dim r As Long, c As Range
r = 1
For Each c In Range("B2:BY2146").Cells
If c.Value <= 1 Then Sheets("Sheet2").Cells(r, 1).Resize(1, 3).Value = Array(c.Value, Cells(c.Row, 1), Cells(1, c.Column))
r = r + 1
Next c
End Sub
Effectively, this sub does nothing. Where am I wrong in the way I am attempting to implement my solution, and what can I do to solve this issue?
Here's an updated sub:
Sub FindMatches()
On Error GoTo errHandler
Dim r As Long, c As Range
Application.ScreenUpdating = False
With Sheets("Sheet2")
r = 1
For Each c In Range("B2:BY2146").Cells
If c.Value <= 1 Then
.Cells(r, 1).Resize(1, 3).Value = Array(c.Value, Cells(c.Row, 1).Value, Cells(1, c.Column).Value)
r = r + 1
End If
Next c
End With
Recover:
On Error Resume Next
Application.ScreenUpdating = True
Exit Sub
errHandler:
MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
Resume Recover
End Sub
Note that Array returns a one-dimensional array, whereas .Value, when assigned an array, expects a 2D one. So I've split the assignments across 3 lines of code.
EDIT
To my surprise, assigning a 1D, zero-based array to the .Value property of a single-row range works beautifully, whereas I thought a 2D, 1-based was a requirement. So my initial paragraph above is baloney and #Profex really found the issue.
A With block provides a bit more performance, and the Application.ScreenUpdating management provides lots more. It is important to reset Application.ScreenUpdating to True in case of error.
Beware of unqualified references, i.e. Range and Cells not preceded by their parent object (e.g. ... In Range("B2:BY2146").Cells and Cells(c.Row, 1); those are looking at whichever worksheet is the active one when they're invoked. In your case, if the source values are on Sheet1, you could use e.g. ... In Sheets("Sheet1").Range("B2:BY2146").Cells and Sheets("Sheet1").Cells(c.Row, 1).
Qualify sheets("sheet1") in the assignment statement & loop.
Put r=r+1 inside the if statement.
Sub FindMatches()
Dim r As Long, c As Range
r = 1
For Each c In Sheets("Sheet1").Range("B2:BY2146").Cells
If c.Value <= 1 Then
Sheets("Sheet2").Range(Cells(r, 1), Cells(r, 3)).Value = Array(c.Value, Sheets("sheet1").Cells(c.Row, 1), Sheets("sheet1").Cells(1, c.Column).Value)
r = r + 1
End If
Next c
End Sub
I want to run an excel vba which will go down column E and upon finding the value = "capa" will go two cell below, calculate the hex2dec value of that cell, present it by the cell with the value "capa" in column F and continue to search down column E.
So far I've came with the below but it doesn't work:
For Each cell In Range("E:E")
If cell.Value = "Capa" Then
ActiveCell.Offset.FormulaR1C1 = "=HEX2DEC(R[2]C[-1])"
End If
Next cell
Thanks!
How about something like this?
This will search volumn E for "Capa" and, if found, will place formula in column F using the value directly below "Capa" in column E
Sub CapaSearch()
Dim cl As Range
For Each cl In Range("E:E")
If cl.Value = "Capa" Then
cl.Offset(0, 1).Formula = "=HEX2DEC(" & cl.Offset(1, 0) & ")"
End If
Next cl
End Sub
You really want to limit the loop so you don't loop over the whole sheet (1,000,000+ rows in Excel 2007+)
Also, copying the source data to a variant array will speed things up too.
Try this
Sub Demo()
Dim dat As Variant
Dim i As Long
With ActiveSheet.UsedRange
dat = .Value
For i = 1 To UBound(dat, 1)
If dat(i, 6 - .Column) = "Capa" Then
.Cells(i, 7 - .Column).FormulaR1C1 = "=HEX2DEC(R[2]C[-1])"
End If
Next
End With
End Sub
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.