I am using the below code to transpose a column off data, however, it still leaves trailing commas. Can someone help to clean this up?
Sub ReorganizeData()
Dim X As Long, LastRow As Long, Index As Long
Dim Sheet As Excel.Worksheet
Const Interval As Long = 1000
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For X = 1 To LastRow Step Interval
Index = Index + 1
Cells(Index, "B") = Application.Trim(Join(Application.Transpose(Cells(X, "A").Resize(Interval).Value), ","))
Next
Range("A:A").Delete xlShiftToLeft
End Sub
The below would be a quick fix but in the process actually suppress any two consecutive commas in the resulting strings regardless of position - if that may be of any concern. The trailing commas are due to joining empty cells, so there may be a better approach to just avoid joing empty cells in the first place
Sub ReorganizeData()
Dim X As Long, LastRow As Long, Index As Long
Dim Sheet As Excel.Worksheet
Const Interval As Long = 1000
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For X = 1 To LastRow Step Interval
Index = Index + 1
Cells(Index, "B") = Application.Trim(Join(Application.Transpose(Cells(X, "A").Resize(Interval).Value), ","))
'Replaces any ",," substring in the above resulting string with an empty string
Cells(Index, "B") = Replace(Cells(Index, "B"), ",,", "")
'Cleans up any possible extra single trailing ","
If Mid(Cells(Index, "B"), Len(Cells(Index, "B")), 1) = "," Then
Cells(Index, "B") = Left(Cells(Index, "B"), Len(Cells(Index, "B")) - 1)
End If
Next
Range("A:A").Delete xlShiftToLeft
End Sub
Edit: # A Hugues - are you saying this is what you are observing after putting the above code to the test? If so I am confused, the extra lines that have been added compared to your original code just consist of replacing any ",," substring within your resulting strings with an empty string - + cleaning up any extra single "," still trailing after that. If that is actually the case - is there any chance you can test as an aside that the replace function actually works as expected?
FYI I confirm this works fine on my end. I have also added a couple comments in the code for clarity
Edit2: there also potentially is the possibility that the 0s that you are seeing now actually already existed in your original strings but went unnoticed after what seemed to be a long series of traling commas, would be great if you could provide a confirmation on this
Related
I am working on a workbook in which I need to count how many times the "St/" substring is present in a Range (Column Q). Note: I am interested in all the occurrences, not just the number of cells in which the substring is present.
Here is the code I am trying to work with (based on the comment of Santhosh Divakar - https://stackoverflow.com/a/23357807/12536295), but I receive a runtime error (13) when running it. What am I missing / doing wrong?
Dim lastrow, q as Integer
lastrow = Range("A1").End(xlToRight).End(xlDown).Row
With Application
q = .SumProduct((Len(Range("Q1:Q" & lastrow)) - Len(.Substitute(Range("Q1:Q" & lastrow), "St/", ""))) / Len("St/"))
End With
See if the code below helps you:
Public Sub TestCount()
lastrow = Range("Q" & Rows.Count).End(xlUp).Row
strformula = "=SUMPRODUCT(LEN(Q1:Q" & lastrow & ")-LEN(SUBSTITUTE(UPPER(Q1:Q" & lastrow & "),""/ST"","""")))/LEN(""/St"")"
MsgBox Evaluate(strformula)
End Sub
I think you can count the number of characters, replace your "St/" with nothing and then count the characters again and divide by len("St/"). Here's an example.
'''your existing code
Dim lCount As Long
Dim lCount_After As Long
'''set a Range to column Q
Set oRng = Range("Q1:Q" & lRow_last)
'''turn that range into a string
sValues = CStr(Join(Application.Transpose(oRng.Value2)))
lCount = Len(sValues)
lCount_After = lCount - Len(Replace(sValues, "St/", ""))
lCount_After = lCount_After / 3
Debug.Print lCount_After
Using ArrayToText() function
a) If you dispose of Excel version MS365 you can shorten a prior string building by evaluating the tabular ARRAYTOTEXT()
formula to get a joined string of all rows at once (complementing #Foxfire 's valid solution).
Note that it's necessary to insert the range address as string;
in order to fully qualify the range reference I use an additional External:=True argument.
b) VBA's Split() function eventually allows to return the number of found delimiters (e.g. "St/") via
UBound() function. It returns the upper boundary (i.e. the largest available subscript) for this
zero-based 1-dimensional split array.
Example: If there exist eight St/ delimiters, the split array consists
of nine elements; as it is zero-based the first element has index 0
and the last element gets identified by 8 which is already the wanted function result.
Function CountOccurrencies(rng As Range, Optional delim as String = "St/")
'a) get a final string (avoiding to join cells per row)
Dim txt As String
txt = Evaluate("ArrayToText(" & rng.Address(False, False, External:=True) & ")")
'b) get number of delimiters
CountOccurrencies = UBound(Split(txt, delim))
End Function
Not the cleanest one, but you can take all into arrays and split by St/. Size of that array would be how many coincidences you got:
Sub test()
Dim LR As Long
Dim MyText() As String
Dim i As Long
Dim q As Long
LR = Range("Q" & Rows.Count).End(xlUp).Row
ReDim Preserve MyText(1 To LR) As String
For i = 1 To LR Step 1
MyText(i) = Range("Q" & i).Value
Next i
q = UBound(Split(Join(MyText, ""), "St/"))
Debug.Print q
Erase MyText
End Sub
The output i get is 8
Please, note this code is case sensitive.
The TextJoin() function in Excel 2019+ is used:
Sub CalcSt()
Const WHAT = "St/": Dim joined As String
joined = WorksheetFunction.TextJoin("|", True, Columns("Q"))
Debug.Print (Len(joined) - Len(Replace(joined, WHAT, ""))) / Len(WHAT)
End Sub
I am trying to write an array to a range and I have tried several ways but no matter what, I always get only the FIRST value of the array over and over again.
Here is the code:
Option Explicit
Sub test()
ActiveWorkbook.Worksheets("Sheet1").Cells.Clear
Dim arrayData() As Variant
arrayData = Array("A", "B", "C", "D", "E")
Dim rngTarget As Range
Set rngTarget = ActiveWorkbook.Worksheets("Sheet1").Range("A1")
'this doesn't work
rngTarget.Resize(UBound(arrayData, 1), 1).Value = arrayData
Dim rngTarget2 As Range
Set rngTarget2 = ActiveWorkbook.Worksheets("Sheet1").Range(Cells(1, 5), Cells(UBound(arrayData, 1), 5))
'this doesn't work either
rngTarget2.Value = arrayData
End Sub
What I expect to see is:
(Col A) (Col E)
A A
B B
C C
D D
E E
What I actually see is:
(Col A) (Col E)
A A
A A
A A
A A
A A
What am I doing wrong here?
I tried to follow Chip Pearson's suggestions, as found HERE
But no luck...
Okay, so adding in the second part of this problem:
I have a 1D array with 8,061 elements that I am passing to the following function as such:
Call writeArrayData7(strTabName, arrayBucketData, 7)
Sub writeArrayData7(strSheetName As String, arrayData As Variant, intColToStart As Integer)
Dim lngNextRow As Long
lngNextRow = 1 ' hard-coded b/c in this instance we are just using row 1
' Select range for data
Dim rngData As Range
Set rngData = Sheets(strSheetName).Range(Cells(lngNextRow, intColToStart), Cells(lngNextRow - 1 + UBound(arrayData, 1), intColToStart))
' Save data to range
Dim arrayDataTransposed As Variant
arrayDataTransposed = Application.Transpose(arrayData)
rngData = arrayDataTransposed
End Sub
So when I run this, the transpose function is properly converting into an:
Array(1 to 8061, 1 to 1)
The range appears to be a single column with 8,061 cells in Column G.
But I get the following error:
Run-time error '1004':
Application-defined or object-defined error
The error is thrown on the following line:
rngData = arrayDataTransposed
--- UPDATE ---
So one thing I left out of my sample code (b/c I honestly didn't think it mattered) was that the contents of my array are actually formulas. Here is the line that I'm using in the actual live code:
arrayData(i) = "=IFERROR(VLOOKUP($D" + CStr(i) + "," + strSheetName + "!$D:$F,3,FALSE),"")"
Well, what I found (with Excel Hero's help) was that the above statement didn't have the double sets of quotes required for a string, so I had to change to this instead:
arrayBucketData(i) = "=IFERROR(VLOOKUP($D" + CStr(i) + "," + strSheetName + "!$D:$F,3,FALSE),"""")"
I can chalk that up to late-night bonehead coding.
However, one other thing I learned is that when I went back to run the full code is that it took FOREVER to paste the array to the range. This would ordinarily be a very simple task and happen quickly, so I was really confused.
After much debugging, I found that the issue came down to the fact that I was turning off all the alerts/calculations/etc and when I pasted in these formulas, the strSheetName sheet was not there yet b/c I'm developing this code separate from the main file. Apparently, it throws up a dialog box when you paste the code in, but if you have all that stuff shut off, you can't see it but it REALLY slows everything down. It takes about 6mins to paste the range if those tabs are not there, and if they exist it takes seconds (maybe less). At any rate, to refine the code a bit further, I simply added a function that checks for the required sheet and if it doesn't exist, it adds the tab as a placeholder so the entire process doesn't slow to a crawl.
Thanks to everyone for their help! I hope this helps someone else down the road.
Do this:
arrayData = Array("A", "B", "C", "D", "E")
[a1].Resize(UBound(arrayData) + 1) = Application.Transpose(arrayData)
The important bit is the Transpose() function.
But it is better to work with 2D arrays from the get go if you plan on writing them to the worksheet. As long as you define them as rows in the first rank and columns in the second, then no transposition is required.
This:
Sub test()
ActiveWorkbook.Worksheets("Sheet1").Cells.Clear
Dim arrayData(1 To 5, 1 To 1) As Variant
arrayData(1, 1) = "A"
arrayData(2, 1) = "B"
arrayData(3, 1) = "C"
arrayData(4, 1) = "D"
arrayData(5, 1) = "E"
Dim rngTarget As Range
Set rngTarget = ActiveWorkbook.Worksheets("Sheet1").Range("A1:A5")
rngTarget = arrayData
End Sub
will produce:
If I may expand the accepted answer, I propose:
[a1].Resize(UBound(arrayData) - LBound(arrayData) + 1) = Application.Transpose(arrayData)
That would be the safe way. This will work no matter if you declare your array variable as:
Dim arrayData(0 to 2)
or
Dim arrayData(1 to 3)
The accepted answer works only in the second case.
The proposed way might be useful if the size of array is unknown and you declare your arrayData as:
Dim arrayData()
The main problem started when I wanted to "convert to number" by the green triangle (I know I can do it by hand, but there are a lot of cells like that and in the future I only want to use code).
So I wanted to do it by code, and I came across with this code that helps, but I have a problem with the number format which removes the decimal numbers.
Sub Valor3()
Dim LastRow As Long, i As Long
LastRow = Sheets("Hoja3").Range("A" & Rows.Count).End(xlUp).Row
'Sheets("Hoja3").Range("A1:A" & LastRow).NumberFormat = "# ##0,00"
For i = 1 To LastRow
If Val(Sheets("Hoja3").Range("A" & i).Value) <> 0 Then _
Sheets("Hoja3").Range("A" & i).Formula = _
Val(Sheets("Hoja3").Range("A" & i).Value)
Next i
End Sub
I've been trying many formats but none of them seems to help.
It might be because here we use the comma as a decimal separator and there is no miles separator.
What number format would help me?
The issue is that you use Val function in combination with a non-us-english decimal separator, which is not a proper solution to your issue.
The Val function recognizes only the period ( .) as a valid decimal separator. When different decimal separators are used, as in international applications, use CDbl instead to convert a string to a number.
Source: Microsoft documentation Val function.
Since the Val function does not convert a text into a value but extracts
The Val function only works with a dot . as decimal separator.
Example:
Val("2.55") 'will return 2.55 as number
Val("2,55") 'will return 2 as number (because it cuts off all text and the comma is not considered as decimal separator)
To get rid of the green triangle and convert a number that is saved as text into a real number properly, use the following:
Option Explicit
Public Sub ConvertNumberAsTextIntoRealNumber()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Hoja3")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
With ws.Range("A1", "A" & LastRow)
.NumberFormat = "# ##0.00" 'set your desired number format
.Value = .Value 'this will in most cases already convert to real numbers.
End With
'But if your numbers are hard coded to text and begin with a `'` you need the following additionally:
Dim iRow As Long
For iRow = 1 To LastRow
With ws.Cells(iRow, "A")
If IsNumeric(.Value) Then 'can the value be interpreted as a number
If .Value <> 0 Then 'is the value not zero
.Value = CDbl(.Value) 'then convert it into a real number
End If
End If
End With
Next iRow
End Sub
I know you are looking for VBA solution, but here's a small Excel trick that you might find useful:
Enter 1 (numeric value) somewhere in the file and copy it:
Select your range (A1:A6) and go to Paste > Paste Special > select Multiply:
The final result is all your text values being converted to numbers:
The same trick will work with other combinations, e.g. Operation: Add while having 0 copied, etc.
So I attempted to use this code to compare two columns between each other, as it is supposedly a much more efficient alternative to vlookup. The code compares the columns and then copy/pastes the matching values to a different column. The source of the code is answer #26 on the following link on MrExcel forums (https://www.mrexcel.com/forum/excel-questions/1043185-vlookup-vba-alternative-3.html#post5014908).
My current problem with the code is that I cannot seem to get it working for string values in general. I've tried several different things from Countif, Wordif, Chardif to various different ways of manipulating strings found on the Ultimate Guide to String Functions and I never got any results.
Once working for string values I would like to have it find strings that have missing letters, superfluous letters, sometimes two letters are different within a word, almost never more than 3 letters are different and sometimes the strings occur in a sentence.
Without a doubt there is something wrong with my code, or maybe I am going about it the wrong way. As with my previous posts I will be working on this table and if I find a solution like with my last two questions I will post it, but this one looks like it is much harder to solve.
Examples of the mispellings and sentences are:
Dataset
Sorry about the text format of the colums, but I could not get https://senseful.github.io/text-table/ to work for me
Column 1:
nbaol®, eraba, eraba, licstclaieaaanli, cdia, cdia, daeic, daeic, xcalea, xcalea, rxedeaa, aneoisstafmalg, ilargc, litaol, aletna, oialrat
Column 2:
nbaaol® eraba i.e. aravcvv. eraba i.e. aravcvv, licstclaieaanli 10 XM/5 XM , cdia (ЛАКАЛД) , прДпДпоеДеноАК, cdia (ЛАКАЛД) прДпДпоеДеноАК , daeic 150SL/250SL čteblpa aeslopjaošitj arsšmemnnd , cdia (ЛАКАЛД) прДпДпоеДеноАК , daeic 150SL/250SL čteblpa aeslopjaošitj arsšmemnnd , xcalea , rlmciém lcoeéplpui. rxedsseaa Mara555 + Kara 645, aneoitamalg 15 BL ðforga, litaol 10 XM/5 XM (ЛАКАЛД) прДпДпоеДеноАК , aletna-MORA, oialrat®, oialrat nbaol® eraba
Links Im working with:
https://www.mrexcel.com/forum/excel-questions/486708-compare-two-strings-find-difference-2.html#post4291032
https://excelmacromastery.com/vba-string-functions/#InStr_Description_ofParameters
Here is the code from the website. I removed the For kk = 2 To 18 par of the code as I do not yet need multiple column copied
Sub testlookup()
Dim lastrow, lastrow2, i As Long
Dim Searchfor, j, inarr As Variant
'Data Dump Sheet
With Sheets("Sheet 2")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(.Cells(1, 1), .Cells(lastrow, 20))
End With
'Values to look up & paste Sheet
With Sheets("Sheet 1")
lastrow2 = .Cells(Rows.Count, "B").End(xlUp).Row
' load variant array with sercha variables
searcharr = Range(.Cells(1, 1), .Cells(lastrow2, 1))
' define an output aray
outarr = Range(.Cells(2, 3), .Cells(lastrow2, 19))
End With
On Error Resume Next
For i = 2 To lastrow2
For j = 2 To lastrow
Searchfor = searcharr(i, 1)
If inarr(j, 1) = Searchfor Then
outarr(i, 3) = inarr(j, 1)
Exit For
End If
Next j
Next i
' writeout the output array
With Sheets("Sheet 1")
Range(.Cells(2, 3), .Cells(lastrow2, 19)) = outarr
End With
End Sub
I want to use VBA to split the contents of a cell into three separate parts, such as [city], [state] [zip code] are put into three different columns on the same row while leaving the original cell unchanged.
I had thought that split would work, but unfortunately I have encountered some complicating issues, first split seems to only carry over the what's on the left, leaving behind the rest, second, I don't see how I can incorporate two delimiters into a single split.
Any idea how to surmount these issues?
Cells(Row1, ColA).Select
Location = ActiveCell.Value
Cells(Row1, ColC) = Split(Location, ",")
Cells(Row1, ColA).Select
Cells(Row1, ColD) = Split(Location, " ")
Cells(Row1, ColA).Select
Cells(Row1, ColE) = Split(Location, " ")
Split() returns an array of strings, you need to iterate through this array and assign the value of each element to the corresponding cell (take a look at this answer).
Also, you don't need to select cells to assign values to it, you may use:
Cells(Row,Column).Value = X
Regarding 2 delimiters, you may do it as described here.
Use the Split, I use an array in the middle just to store the split String (in case you will want to use it later), it also saves me the time of the iteration.
Sub Split_toThree()
Dim lrow As Long
Dim LastRow As Long
Dim SplitArr() As String
' find last row in Column A (where you keep your full string)
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For lrow = 2 To LastRow
SplitArr() = Split(Cells(lrow, "a"), ",")
Range("C" & lrow & ":E" & lrow) = SplitArr()
Next lrow
End Sub