I need to find away to be able to combine consecutive numbers. It could be either by formula or VBA code, but I honestly don't know where to start and I could not find anything similar posted that I could use for my case.
Ex:
This:
9630184784, 9630184786, 9630184787, 9630184788, 9630184814, 9630184815, 9630184816, 9630184817
To:
9630184784, 9630184786-9630184788, 9630184814-9630184817
Thanks in advance!
Hyra
=MID(CONCAT(IFERROR(CHOOSE(MMULT(COUNTIF(A:A,A$1:A$8+{1,-1}),{1;3}/2)+1,",","-")&A1:A8,"")),2,99)
#Excel 2019
=MID(CONCAT(IFERROR(CHOOSE(MMULT(COUNTIF(A1,"*"&FILTERXML("<a><b>"&SUBSTITUTE(A1,","," </b><b>")&"</b></a>","a/b")+{1,-1}&"*"),{1;3}/2)+1,",","-")&FILTERXML("<a><b>"&SUBSTITUTE(A1,","," </b><b>")&"</b></a>","a/b"),"")),2,99)
#Excel 365
=LET(x,FILTERXML("<a><b>"&SUBSTITUTE(A1,","," </b><b>")&"</b></a>","a/b"),MID(CONCAT(IFERROR(CHOOSE(MMULT(COUNTIF(A1,"*"&x+{1,-1}&"*"),{1;3}/2)+1,",","-")&x,"")),2,99))
Answer change from 象山海鲜.
This VBA function worked fine for me. It was posted by mikerickson at mrexcel.
https://www.mrexcel.com/board/threads/convert-list-of-sequential-numbers-into-ranges.978486/
Function IntoRanges(aString As String, Optional Delimiter As String = ",") As String
Dim NextBit As String
Dim i As Long
Dim Items As Variant
Items = Split(aString, Delimiter)
IntoRanges = Items(0)
For i = 0 To UBound(Items) - 1
If Val(Items(i)) + 1 = Val(Items(i + 1)) Then
NextBit = "-" & Val(Items(i + 1))
Else
If NextBit = vbNullString Then
IntoRanges = IntoRanges & Delimiter & Val(Items(i + 1))
Else
IntoRanges = IntoRanges & NextBit & Delimiter & Val(Items(i + 1))
NextBit = vbNullString
End If
End If
Next i
IntoRanges = IntoRanges & NextBit
End Function
Related
I am new to Excel VBA.
I have these random columns:
Range("Y1").Value = "LITIGATE_PERSON_ADDRESS"
Range("Z1").Value = "LITIGATE_PERSON_CITY"
Range("AA1").Value = "LITIGATE_PERSON_TK"
Range("AB1").Value = "LITIGATE_PERSON_ADDRESS_TYPE"
Here's the part of code that is being used for these columns.
Worksheets("MAIN_CONTROL").Cells(i, 25).Value = sourceADR
sourceADR = Replace(sourceADR, "Attica", "")
'...................................................................
sourceADR = Replace(sourceADR, "-", " ")
sourceADR = Replace(sourceADR, " ", " ")
sourceADR = Trim(sourceADR)
auxC = sourceADR
Worksheets("MAIN_CONTROL").Cells(i, 26).Value = sourceADR
'..............................
If (Len(sourceADR) < 1) Then GoTo aseAddr
'..............
mainAddress = Split(sourceADR)
addrAA = ""
Worksheets("MAIN_CONTROL").Cells(i, 24).Value = Str(UBound(mainAddress)) & "##" & Str(LBound(mainAddress))
For jA = UBound(mainAddress) To LBound(mainAddress) Step -1
'......................................................
If (regex.Test(Trim(mainAddress(jA)))) Then
auxC = Replace(auxC, Trim(mainAddress(jA)), "")
destws.Range("BT" & i).Value = Trim(mainAddress(jA))
destws.Range("AA" & i).Value = Trim(mainAddress(jA))
destws.Range("Z" & i).Value = addrAA
auxC = Trim(auxC)
destws.Range("Y" & i).Value = auxC
'--------------------------------------------------------
'-------------------------------------------------------
GoTo aseAddr
End If
auxC = Replace(auxC, Trim(mainAddress(jA)), "")
addrAA = mainAddress(jA) & " " & addrAA
'
'.....................................................
Next jA
'.........................................................
'destws.Range("Y" & i).Value = addrAA
'.....................
aseAddr:
'.................................
My problem is that these columns may change order.
I was suggested to use application.match so that my code may follow but i don't know how to put it inside my code.
Can anyone help?
Thanks in advance
Welcome to SO.
In general, the way you can use an excel function in VBA is the following:
application.WorksheetFunction.Match() 'where match() can be replaced by one of the available worksheet functions.
The function's arguments work pretty much the same way as they do when you use the formula in your worksheet.
The Match functionality is explained thoroughly here
So for example let's say you have an array like the following one in cells A1:A13
And you want to find the location of "Friday". You would do it like so:
Debug.Print Application.WorksheetFunction.Match("Friday", sht.Range("A1:A13"), 0)
And you would get 5 as a result.
That should pretty much cover the "How to use Application.Match()".
I am new to VBA in excel. So, i create a string from multiple parts and output it in a cell on some sheet like this:
Sheets("Output").Cells(iRow, 1).Value = LArray(0) + "?" + adding + "/#" + LArrayNew(1)
I am expecting: text?text/#text
But result on excel sheet is: text?text#text
Where is the "/"?
Something like:
Sub dural()
Dim LArray(0 To 1) As String
Dim adding As String, LArrayNew(0 To 1) As String
adding = "X"
LArrayNew(1) = "New"
LArray(0) = "0"
iRow = 1
Sheets("Output").Cells(iRow, 1).Value = LArray(0) & "?" & adding & "/#" & LArrayNew(1)
End Sub
will produce:
0?X/#New
Note the slash is there!
I am trying to use the code below, however I don't understand why it is printing out a blank message box? Additionally, there is only one for each day, and it is saying there is 2 files?
How do I print these back effectively, second, how do I then use that to open the sheet?
The files are written as samadmin15112018_??????.csv Where the question marks are a time stamp which I don't know.
Sub runFA()
Const yourfilepath = "R:\samsdrive\sam\test\"
Dim s As String
Dim x As Integer
Dim v() As String
s = Dir(yourfilepath & "samadmin" & format(Sheets("Name").Range("C3"), "yyyymmdd") & "_*.csv")
v = Split(vbNullString)
Do Until s = ""
x = x + 1
ReDim Preserve v(x + 1)
s = Dir()
Loop
If UBound(v) > 0 Then
MsgBox "There are " & UBound(v) & " workbooks", vbOKOnly
MsgBox v(x + 1)
Else
If v(0) <> "" Then Workbooks.Open (yourfilepath & v(0))
MsgBox ("There are 0 ")
End If
End Sub
Fixing the previous answer...
You were getting an empty element because the original code resized the array for the first element, which meant that v(0) was always going to be vbNullString. With string arrays, you can take advantage of the Split function's behavior of returning an array with a UBound of -1 and an LBound of 0 if you're going to add elements to it dynamically:
Sub runFA()
Const targetPath = "R:\samsdrive\sam\test\"
Dim located() As String
located = Split(vbNullString)
Dim result As String
result = Dir$(targetPath & "samadmin" & Format$(Sheets("Name").Range("C3"), "yyyymmdd") & "_*.csv")
Do Until result = vbNullString
ReDim Preserve located(UBound(located) + 1)
located(UBound(located)) = result
result = Dir$()
Loop
If UBound(located) <> 0 Then
MsgBox "There are " & (UBound(located) + 1) & " workbooks", vbOKOnly
Else
Workbooks.Open targetPath & result
End If
End Sub
A couple other things to note
I changed the variable names from single letter identifiers to something a little easier to read and understand.
The indentation is now consistant.
It uses the string typed functions for Dir and Format.
You don't need to track the count of results with x at all.
If you only have one element in the results array, you can simply use result - there isn't any reason to index back into the array.
I need to maintain a count of replacements made before implementing the Worksheets(...).Columns(...).Replace function using Excel VBA.
Can anyone guide me regarding code that I probably need to insert in *** below for counting the replacements that are about to occur in the next line of code? Thanks.
Function Value_Replace(TabName As String, ColumnTitle As String, val_Old As String, val_New As String)
Dim MyColumn, CountReplacements As Long
Dim MyColumnLetter As String
MyColumn = WorksheetFunction.Match(ColumnTitle, ActiveWorkbook.Sheets(TabName).Range("1:1"), 0)
'CountReplacements = ***?
Worksheets(TabName).Columns(MyColumnLetter).Replace _
what:=val_Old, Replacement:=val_New, _
SearchOrder:=xlByColumns, MatchCase:=False
Value_Replace = "Values " & CountReplacements & " in column " & MyColumnLetter & " updated!"
End Function
I propose to store in the cell (eg [A1]) and the number of repetitions for each call to change to increment it. But it must be the end of all calculations to clear the cell that would be the next time you call this function, the function would not start incrementing the previous value.
Some will look like this:
[A1].value = [A1].value + 1
CountReplacements = [A1].value
How about using COUNTIF with * Old_Str *? You don't need to count the actual replacements before they happen, just find out how many occurrences of Old_Str there are in your column within the contents of each cell before you start the replacement. Doing it on New_Str after you'd replaced it would be unwise unless you could guarantee there were no occurrences of New-Str before you executed the replacement .
CountReplacements = WorksheetFunction.CountIf(ActiveSheet.Columns(MyColumnLetter), "*" & val_Old & "*")
Give it a go and see
Thanks. But this worked as well:
While Not ConsecutiveEmpty = 1
If IsEmpty(Worksheets("Sheet1").Cells(LastRow, 2).Value) Then
ConsecutiveEmpty = ConsecutiveEmpty + 1
End If
LastRow = LastRow + 1
Wend
MyCount = 0
For i = 2 To LastRow
If Worksheets("Sheet1").Cells(i, MyColumn).Value = val_Old Then
MyCount = MyCount + 1
End If
Next
Here is some of my code:
Dim wbX As Workbook
Dim wbY As Workbook
Set wbX = Application.Workbooks.Open("C:\Converter\aaa.xls")
Set wbY = Application.Workbooks.Open("C:\Converter\bbb.xlsx")
For i = 1 To wbX.Sheets.Count
wbY.Sheets(1).Activate
Range("Y" & i + 2).Select
ActiveSheet.Range("Y" & i + 2).Formula = "=RIGHT(("S" & i + 2); 4)"
The problem is that ("S" & i + 2) is not recognized as a cell - VBA spits out syntax errors.
Your expression "Y" & i + 2 does not yield a valid cell reference because you concatenate a number to a string. You must convert the numeric expression to a string:
"Y" & Str(i + 2)
What I understand from your comment, the assignment should be written as:
"=LEFT(S" & Trim(Str(i + 2)) & "; 4)" ' yields e.g.: =LEFT(S3; 4)
(The LEFT function gets the first characters from a string. This assumes the cells you reference contains strings, or that VB converts the value to a string first. And here you must use Trim(Str(i + 2)) because you are constructing a string to place as a formula in the cell.)
Maybe this example helps you:
Option Explicit
Sub test()
Dim rngC As Range
For Each rngC In Range("C2:C100")
rngC.Offset(0, 4) = Right(rngC, 4)
Next
End Sub