Related
The following code gives me a compile error:expected: separator or ).
Public Sub test1()
Dim first_column As String,a_tab as string
a_tab="Sheet1"
first_column = "A"
ThisWorkbook.Sheets(a_tab).Range(first_column&"10").value="hello"
End Sub
I know we can do it when the row reference is a variable, i.e.
Public Sub test1()
dim fist_row as integer, a_tab as string
a_tab="Sheet1"
first_row=10
ThisWorkbook.Sheets(a_tab).Range("A"&first_row).value="hello"
End Sub
Could someone help? Many thanks.
Get out of the habit of using a letter for the column designation.
Your first column is column 1:
Columns(1).Value = "Hello" will place "Hello" in every cell in column 1 - Range(A1:A1048576).
The second cell in column 1:
Cells(2, 1) = "Hello" will place "Hello" in row 2, column 1 - Range(A2).
A range of cells designated by a start and end cell:
Range(Cells(2, 1), Cells(4, 2)) = "Hello" will place "Hello" in every cell between row 2, column 1 and row 4, column 2 - Range("A2:B4")
The first, second, third & fourth columns:
Range(Cells(1,1),Cells(1,4)).EntireColumn - Range("A:D").
But, saying that the only thing that caused your code to fail was spacing. You'll notice with the row variable it keeps putting the spaces back in - doesn't seem to do that with the column variable:
ThisWorkbook.Sheets(a_tab).Range(first_column & "10").Value = "hello"
- add a space either side of the ampersand.
Edit:
Consider placing values in columns CB:CL using a loop. Using numbers you'd just write:
Sub Test()
Dim x As Long
For x = 80 To 90
Cells(1, x) = "Hello"
Next x
End Sub
Using letters you'd have to use something like:
Sub Test()
Dim col_Letter As String
col_Letter = "CB"
Do
Range(col_Letter & "10") = "Hello"
'Get the next column letter by finding the address, splitting it and extracting just the column letter.
col_Letter = Split(Range(col_Letter & "10").Offset(, 1).Address(True, False), "$")(0)
Loop While col_Letter <> "CL"
End Sub
Are you missing spaces when concatenating strings in your argument to Range? ThisWorkbook.Sheets(a_tab).Range(first_column & "10").value="hello" Works for me if I add the spaces.
I have this text in cell A2:
2018 / Erbe / France / Beflubu, zolin, Benflu, sate, furon, Bensu /
Show only: VARIABLE / Value ($ m): 169.46
I am trying to copy only the value of VARIABLE into cell D2.
Everything in this cell can vary, the only fixed things are "Show Only:", "Value ($):", all the / characters, and . (in the number part of the value)
I am trying to do it in VBA.
Try the code below, explanations inside the code's comments:
Option Explicit
Sub ExtractAfterShowOnly()
Dim WordsArr() As String
Dim i As Long
Dim MatchString As String
' use Split to read each section between "/" as arra element
WordsArr = Split(Range("A2").Value2, " / ")
' loop through array
For i = 1 To UBound(WordsArr)
' if there's a match, get the text inside and exit the loop
If WordsArr(i) Like "*Show only:*" Then
MatchString = WordsArr(i)
Exit For
End If
Next i
' Use Mid function to show the string after "Show only:"
MsgBox Mid(MatchString, Len("Show only:") + 1)
End Sub
I have a comment field with cells containing text like this:
Cancelled by user at 2018-01-03 03:11:57 without charge
I want to get the date and time information, but it may not always be in the 3rd/4th from last spaces, otherwise I might try to do some sort of complicated split of the cell. Is there an "in cell" way extract the date time information? Or will this need a VBA script? I prefer the former, but I'm trying to make a macro to simplify my life anyway, so VBA would work too.
I'd propose the following formula:
=MID(A1,FIND("at 20",A1)+3,19)
This would require that the date is always preceded by the word 'at' and the date string starts with 20.
You can try this function. It splits the string checking for items that have the first letter numeric, and builds a result string of just the date information.
Public Function ParseForDate(sCell As String) As String
Dim vSplit As Variant
Dim nIndex As Integer
Dim sResult As String
vSplit = Split(sCell, " ")
For nIndex = 0 To UBound(vSplit)
If IsNumeric(Left$(vSplit(nIndex), 1)) Then
sResult = sResult & vSplit(nIndex) & " "
End If
Next
ParseForDate = Trim$(sResult)
End Function
If you wanted to use it in a formula it would look something like this:
=ParseForDate(A1)
To use it in a VBA routine:
Dim s as String
s = ParseForDate(Range("A1"))
Non-VBA solution: (this is assuming the date format is always the same for all cells)
= MAX(IFERROR(DATEVALUE(MID(A1,ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(A1)-19)),20)),0))
+MAX(IFERROR(TIMEVALUE(MID(A1,ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(A1)-19)),20)),0))
Note this is an array formula, so you must press Ctrl+Shift+Enter instead of just Enter when typing this formula.
You will obviously then need to format the cell as a date and time, but this formula gets the numerical value that Excel uses for its internal date and time system.
Using a regex will enable you to fetch the date and time, irrespective of its placement in the string. The following solution will work if the date and time are of the same format as shown in the example string.
Code:
Sub getDateTime()
Dim objReg, matches, str
str = Sheet1.Cells(1, 1).Value 'Change this as per your requirements
Set objReg = CreateObject("vbscript.regexp")
objReg.Global = True
objReg.Pattern = "\d{4}(?:-\d{2}){2}\s*\d{2}(?::\d{2}){2}"
If objReg.test(str) Then
Set matches = objReg.Execute(str)
strResult = matches.Item(0)
MsgBox strResult
End If
End Sub
Click for Regex Demo
Regex Explanation:
\d{4} - matches 4 digits representing the year
(?:-\d{2}){2} - matches - followed by 2 digits. {2} in the end repeats this match 2 times. Once for getting MM and the next time for DD
\s* - matches 0+ whitespaces to match the space between the Date and Time
\d{2} - matches 2 digits representing the HH
(?::\d{2}){2} - matches : followed by 2 digits. The {2} in the end repeats this match 2 times. First time for matching the :MM and the next time for matching the :SS
Screenshots:
Output:
This will be good for about 90 years (using cell C3 for example):
Sub GetDate()
Dim s As String
s = Range("C3").Comment.Text
arr = Split(s, " ")
For i = LBound(arr) To UBound(arr)
If Left(arr(i), 2) = "20" Then
msg = arr(i) & " " & arr(i + 1)
MsgBox msg
Exit Sub
End If
Next i
End Sub
Table to sort:
I have a 2000-ish entry table. The first column contains an ID (non-unique) of the following type: [numeric 1-52][letters][optional underscore][optional numeric 1-10]. Letters will be either [a], [b], [c], [sa], [sb], [sc].
Example: 1c, 10sb_3, 5a, 12c, 3sc, 21c_1, 22c_4, 22b_10, 14sb, 26sb.
How I want the sorting done
I want to sort by type (letter) first, in the order I named them before the example above. In case of same type, I want to sort by the first number. In case of same first number (both optional parameters will be present) I want to sort by the last number. The sorting should extend to the rest of the row (table) as well.
Desired end result
1c
1c
1c
2c
3c
3c
4c_1
4c_2
4c_3
5c
6c_1
.......
1b
2b
2b
3b
4b_1
4b_2
5b
5b
.......
etc
What I intended to do (may not be the best idea)
Using the answer of this question as a starting point: Code an Excel VBA sort with a custom order and a value containing commas
I could make an algorithm which creates a second list, on the side, removing all duplicates, and order that list how I want manually. It would take a while, and is possibly incredibly inefficient. When it is done, I would use a piece of code similar to the answer's:
Dim oWorksheet As Worksheet
Set oWorksheet = ActiveWorkbook.Worksheets("Sheet1")
Dim oRangeSort As Range
Dim oRangeKey As Range
' one range that includes all colums do sort
Set oRangeSort = oWorksheet.Range("A1:J2000") ' <<<<I'd set the range right, of course
' start of column with keys to sort
Set oRangeKey = oWorksheet.Range("B1") '<<<What is this for?
' custom sort order
Dim sCustomList(x To y) As String
'There would be a loop here filling the array in order with my manually sorted list
Application.AddCustomList ListArray:=sCustomList
' use this if you want a list on the spreadsheet to sort by
' Application.AddCustomList ListArray:=Range("D1:D3")
' ^^^^ for the record I'm not sure what this accomplishes in my case. Should I remove it? I feel it is just a different way to fill the array, using the range directly instead of filling with a loop. Maybe it suits me more?
oWorksheet.Sort.SortFields.Clear
oRangeSort.Sort Key1:=oRangeKey, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
' clean up
Application.DeleteCustomList Application.CustomListCount
Set oWorksheet = Nothing
Personally, unless you need to do this as part of a larger piece of code, I wouldn't use VBA and would just do this by adding a column to your data sheet that gives you the correct sort order.
To extract the relevant pieces of your ID (assuming it starts in cell "A1") you need to pull out the letters from your string:
=MID(A1,MIN(FIND({"a","b","c","s"},A1&"abcs")),IF(ISNUMBER(FIND("s",A1)),2,1))
Next you need the first number:
=LEFT(A1,MIN(FIND({"a","b","c","s"},A1&"abcs"))-1)
Then you need to add on the second number if it exists:
=IF(ISNUMBER(FIND("_",A1)),RIGHT(A1,LEN(A1)-FIND("_",A1))*1,0)
Putting these all into a single formula and formatting the numbers to take account of single or double-digit numbers gives:
=MID(A1,MIN(FIND({"a","b","c","s"},A1&"abcs")),IF(ISNUMBER(FIND("s",A1)),2,1))&TEXT(LEFT(A1,MIN(FIND({"a","b","c","s"},A1&"abcs"))-1),"00")&TEXT(IF(ISNUMBER(FIND("_",A1)),RIGHT(A1,LEN(A1)-FIND("_",A1))*1,0),"00")
Which is probably not the simplest way of achieving it, but will give you a column of strings which you can use as your sort order.
The only thing I am confused about is that your question said that the letters needed to be sorted in the order that you listed them, but your example showed "c" coming before "b". If you need the letters to be in non-alphabetical order, we would need to adjust the first part of this formula.
If possible, to make it easier, the first thing I'd suggest is to keep the fields (type, first number, special parameter, optional numeric) all the same lenght, that would make the algorithm incredibly easier.
1c2 becomes 01oc-02
23sa_13 keeps 23sa_13
But if you don't have that possibility, here it goes:
This separates all values in a new sheet, one by one, including repeated
Option Explicit
Sub SortData()
Dim MySheet As Worksheet, NewSheet As Worksheet
Set MySheet = ThisWorkbook.Worksheets("Sheet1")
Set NewSheet = ThisWorkbook.Worksheets.Add()
NewSheet.Range("A1").value = "Type"
NewSheet.Range("B1").value = "First Number"
NewSheet.Range("C1").value = "Underscore"
NewSheet.Range("D1").value = "Last Number"
Dim CurrentRange As Range
Dim i As Integer
For i = 2 To 2000 'the rows you are going to consider
'you may replace this for a while cell is not empty check
'considering the first row is a header, not a value
Set CurrentRange = MySheet.Cells(i, 1) 'gets the cell in row i and column 1
Dim CurrentValue As String
CurrentValue = CurrentRange.value 'gets the value of the cell
'if cell is empty, stop loop
If CurrentValue = "" Then
Exit For
End If
Dim FirstNumberSize As Integer
Dim TypeSize As Integer
Dim UnderscoreSize As Integer
Dim LastNumberSize As Integer
Dim StartChar As Integer
StartChar = 1
Call GetFieldSizes(CurrentValue, FirstNumberSize, TypeSize, UnderscoreSize, LastNumberSize)
'write the values in a new sheet
NewSheet.Cells(i, 2).value = Mid(CurrentValue, StartChar, FirstNumberSize) 'write firstnumber in the new sheet
StartChar = StartChar + FirstNumberSize 'advance to the next field
NewSheet.Cells(i, 1).value = Mid(CurrentValue, StartChar, TypeSize) 'write type in the new sheet
StartChar = StartChar + TypeSize
NewSheet.Cells(i, 3).value = Mid(CurrentValue, StartChar, UnderscoreSize) 'write underscore in the new sheet - nothing if size is zero
StartChar = StartChar + UnderscoreSize
NewSheet.Cells(i, 4).value = Mid(CurrentValue, StartChar, LastNumberSize) 'write lastNumber in the new sheet - nothing if size is zero
Next
End Sub
Sub GetFieldSizes(value As String, ByRef firstNum As Integer, ByRef entryType As Integer, ByRef Underscore As Integer, ByRef lastNum As Integer)
'walk through each char of the value while it's a number
Dim Continue As Boolean
Dim charVal As String
Dim valLength As Integer
valLength = Len(value) 'the length of the string
'find first number size
firstNum = 0 'start from character zero
Continue = True 'to check if I can advance to the next char
Do
'if the next char is not a number, we found the letters
If Not IsNumeric(Mid(value, firstNum + 1, 1)) Then
Continue = False 'I say I cannot advance anymore, the size of our number is found
Else
firstNum = firstNum + 1 'advance one char
End If
Loop While Continue = True 'repeat while I can continue
'find first underscore or digit of last number
For Underscore = firstNum + 1 To valLength 'from the first char after the first number to the end of the string
charVal = Mid(value, Underscore, 1) 'get the value of the char in the current underscore position
If charVal = "_" Then 'if the char is an underscore
lastNum = valLength - Underscore 'the remaining chars are the last number
Underscore = 1 'the actual size of the underscore is 1
Exit For 'interrupt the loop
ElseIf IsNumeric(charVal) Then 'if the char is a number
lastNum = valLength - Underscore + 1 'the remaining chars, including this one are the last number
Underscore = 0 'if I find a number instead of the underscore, it doesn't exist, say it's length is zero
Exit For 'interrupt the loop
End If
Next
'if I advanced to the end of the string, I didn't find any number of underscore
If Underscore > valLength Then
lastNum = 0
Underscore = 0
End If
entryType = valLength - firstNum - Underscore - lastNum 'the size of the letters is the remaining size when you remove the other sizes
End Sub
I have a list of filenames in a spreadsheet in the form of "Smith, J. 010112.pdf". However, they're in the varying formats of "010112.pdf", "01.01.12.pdf", and "1.01.2012.pdf". How could I change these to one format of "010112.pdf"?
Personally I hate using VBA where worksheet functions will work, so I've worked out a way to do this with worksheet functions. Although you could cram this all into one cell, I've broken it out into a lot of independent steps in separate columns so you can see how it's working, step by step.
For simplicity I'm assuming your file name is in A1
B1 =LEN(A1)
determine the length of the filename
C1 =SUBSTITUTE(A1," ","")
replace spaces with nothing
D1 =LEN(C1)
see how long the string is if you replace spaces with nothing
E1 =B1-D1
determine how many spaces there are
F1 =SUBSTITUTE(A1," ",CHAR(8),E1)
replace the last space with a special character that can't occur in a file name
G1 =SEARCH(CHAR(8), F1)
find the special character. Now we know where the last space is
H1 =LEFT(A1,G1-1)
peel off everything before the last space
I1 =MID(A1,G1+1,255)
peel off everything after the last space
J1 =FIND(".",I1)
find the first dot
K1 =FIND(".",I1,J1+1)
find the second dot
L1 =FIND(".",I1,K1+1)
find the third dot
M1 =MID(I1,1,J1-1)
find the first number
N1 =MID(I1,J1+1,K1-J1-1)
find the second number
O1 =MID(I1,K1+1,L1-K1-1)
find the third number
P1 =TEXT(M1,"00")
pad the first number
Q1 =TEXT(N1,"00")
pad the second number
R1 =TEXT(O1,"00")
pad the third number
S1 =IF(ISERR(K1),M1,P1&Q1&R1)
put the numbers together
T1 =H1&" "&S1&".pdf"
put it all together
It's kind of a mess because Excel hasn't added a single new string manipulation function in over 20 years, so things that should be easy (like "find last space") require severe trickery.
Here's a screenshot of a simple four-step method based on Excel commands and formulas, as suggested in a comment to the answered post (with a few changes)...
This function below works. I've assumed that the date is in ddmmyy format, but adjust as appropriate if it's mmddyy -- I can't tell from your example.
Function FormatThis(str As String) As String
Dim strDate As String
Dim iDateStart As Long
Dim iDateEnd As Long
Dim temp As Variant
' Pick out the date part
iDateStart = GetFirstNumPosition(str, False)
iDateEnd = GetFirstNumPosition(str, True)
strDate = Mid(str, iDateStart, iDateEnd - iDateStart + 1)
If InStr(strDate, ".") <> 0 Then
' Deal with the dot delimiters in the date
temp = Split(strDate, ".")
strDate = Format(DateSerial( _
CInt(temp(2)), CInt(temp(1)), CInt(temp(0))), "ddmmyy")
Else
' No dot delimiters... assume date is already formatted as ddmmyy
' Do nothing
End If
' Piece it together
FormatThis = Left(str, iDateStart - 1) _
& strDate & Right(str, Len(str) - iDateEnd)
End Function
This uses the following helper function:
Function GetFirstNumPosition(str As String, startFromRight As Boolean) As Long
Dim i As Long
Dim startIndex As Long
Dim endIndex As Long
Dim indexStep As Integer
If startFromRight Then
startIndex = Len(str)
endIndex = 1
indexStep = -1
Else
startIndex = 1
endIndex = Len(str)
indexStep = 1
End If
For i = startIndex To endIndex Step indexStep
If Mid(str, i, 1) Like "[0-9]" Then
GetFirstNumPosition = i
Exit For
End If
Next i
End Function
To test:
Sub tester()
MsgBox FormatThis("Smith, J. 01.03.12.pdf")
MsgBox FormatThis("Smith, J. 010312.pdf")
MsgBox FormatThis("Smith, J. 1.03.12.pdf")
MsgBox FormatThis("Smith, J. 1.3.12.pdf")
End Sub
They all return "Smith, J. 010312.pdf".
You don't need VBA. Start by replacing the "."s with nothing:
=SUBSTITUTE(A1,".","")
This will change the ".PDF" to "PDF", so let's put that back:
=SUBSTITUTE(SUBSTITUTE(A1,".",""),"pdf",".pdf")
Got awk? Get the data into a text file, and
awk -F'.' '{ if(/[0-9]+\.[0-9]+\.[0-9]+/) printf("%s., %02d%02d%02d.pdf\n", $1, $2, $3, length($4) > 2 ? substr($4,3,2) : $4); else print $0; }' your_text_file
Assuming the data are exactly as what you described, e.g.,
Smith, J. 010112.pdf
Mit, H. 01.02.12.pdf
Excel, M. 8.1.1989.pdf
Lec, X. 06.28.2012.pdf
DISCLAIMER:
As #Jean-FrançoisCorbett has mentioned, this does not work for "Smith, J. 1.01.12.pdf". Instead of reworking this completely, I'd recommend his solution!
Option Explicit
Function ExtractNumerals(Original As String) As String
'Pass everything up to and including ".pdf", then concatenate the result of this function with ".pdf".
'This will not return the ".pdf" if passed, which is generally not my ideal solution, but it's a simpler form that still should get the job done.
'If you have varying extensions, then look at the code of the test sub as a guide for how to compensate for the truncation this function creates.
Dim i As Integer
Dim bFoundFirstNum As Boolean
For i = 1 To Len(Original)
If IsNumeric(Mid(Original, i, 1)) Then
bFoundFirstNum = True
ExtractNumerals = ExtractNumerals & Mid(Original, i, 1)
ElseIf Not bFoundFirstNum Then
ExtractNumerals = ExtractNumerals & Mid(Original, i, 1)
End If
Next i
End Function
I used this as a testcase, which does not correctly cover all your examples:
Sub test()
MsgBox ExtractNumerals("Smith, J. 010112.pdf") & ".pdf"
End Sub