I've done quite a bit of searching around for this one...and I'm not getting anywhere.
I have a spreadsheet(specific column) with values such as:
42153-95
54126-3
13613-6331
16136-336
My goal is to add zero's after the - and before the existing #'s(to 4 places). Like:
42153-0095
54126-0003
13613-6331
16136-0336
I've tried a a lot of different options within the quotes of NumberFormat:
Worksheets("Sheet1").Columns("C"). _ NumberFormat = "00000-0000"
No luck so far. :(
Any help would be greatly appreciated.
Thanks!
Sub testFunc()
MsgBox addZero("54126-3")
End Sub
'/ Function to add Zeros
Public Function addZero(strVal As String) As String
Dim arrTemp
Dim strTemp
arrTemp = Split(strVal, "-")
strTemp = arrTemp(0) & "-" & String(4 - Len(arrTemp(1)), "0") & arrTemp(1)
addZero = strTemp
End Function
As #tigeravatar stated it can be done with a formula. With the Evaluate function we can use an array form of the formula he gave in his comment.
You can apply this to your values in column C:
Worksheets("Sheet1").Range("C1:C4").Value = Worksheets("Sheet1").Evaluate("=INDEX(LEFT(C1:C4,6) & TEXT(--MID(C1:C4,7,LEN(C1:C4)),""0000""),)")
If your range is dynamic and you have the final row in a variable like lstrow you can replace all the C4 with C" & lstrow & "
Worksheets("Sheet1").Range("C1:C" & lstrow).Value = Worksheets("Sheet1").Evaluate("=INDEX(LEFT(C1:C" & lstrow & ",6) & TEXT(--MID(C1:C" & lstrow & ",7,LEN(C1:C" & lstrow & ")),""0000""),)")
Select the cells you wish to process and run:
Sub dural()
Dim r As Range
bry = Array("0000", "000", "00", "0", "")
For Each r In Selection
ary = Split(r.Value, "-")
ary(1) = bry(Len(ary(1))) & ary(1)
r.Value = Join(ary, "-")
Next r
End Sub
Before:
and after:
Related
My spreadsheet currently has a column C with rows of data that have this structure below:
123 - abc - xyz
I want my VBA code to remove all the data before the first - including the - so that the column C would look like this:
abc - xyz
My current code is removing both "-"
Sub TrimCell()
Dim i As String
Dim k As String
i = "-"
k = ""
Columns("C").Replace what:=i, replacement:=k, lookat:=xlPart,
MatchCase:=False
End Sub
The Excel function I have for this is =REPLACE(C1,1,FIND("-",C1),""). This works but I want something in VBA.
This will work on column C:
Sub my_sub()
Dim c As Range
For Each c In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("C:C"))
c = Trim(Mid(c, InStr(c, "-") + 1))
Next
End Sub
You want to find the location of the first "-"
location = instr(1, cells(iRow,3), "-", vbTextCompare)
Taking advantage of fact that instr only returns the first entry...
Then trim the cell to the right using that location
if location > 0 then
'Found a "-" within this cell
cells(iRow,3) = right(cells(iRow,3), len(cells(iRow,3)-location)
end if
iRows is obviously just my iterator over the rows in your data. Define it whatever way you want.
You could dot it in one go using Evaluate.
With Range("C1", Range("C" & Rows.Count).End(xlUp))
.Value = Evaluate("MID(" & .Address & ", FIND(""-"", " & .Address & ")+1, LEN(" & .Address & "))")
End With
Please, try the next function:
Function replaceFirstGroup(x As String) As String
Dim arr
arr = Split(x, " - ")
arr(0) = "###$"
replaceFirstGroup = Join(Filter(arr, "###$", False), " - ")
End Function
It can be called/tested in this way:
Sub testReplaceFirstGroup()
Dim x As String
x = "123 - abc - xyz"
MsgBox replaceFirstGroup(x)
End Sub
In order to process C:C column, using the above function, please use the next code. It should be extremely fast using an array, working in memory and dropping the processing result at once:
Sub ProcessCCColumn()
Dim sh As Worksheet, lastR As Long, arr, i As Long
Set sh = ActiveSheet
lastR = sh.Range("C" & sh.rows.count).End(xlUp).row
arr = sh.Range("C2:C" & lastR).value
For i = 1 To UBound(arr)
arr(i, 1) = replaceFirstGroup(CStr(arr(i, 1)))
Next i
sh.Range("C2").Resize(UBound(arr), 1).value = arr
End Sub
I have a cell in that contains the following:
=$H$10+1&","&B5+I10&","&(2*$D$2+$E$2)/2
The result of this formula is in this format:
14649,28.25,5.5
I want to use the formula VBA code. I want the number 1 in the $H$10+**1**&" to be the i of the for loop and the I10 in "&B5+I10&" to also change with the loop.
For i=1 to lastrow
.Range("X" & 13+i & "").Formula = "=$H$10+" & i & "" & "," & "B5+I" & i + 10 & "" & "," & "(2*$D$2+$E$2)/2"
Next i
Here code that can be used:
Sub mySub()
'=$H$10+1&","&B5+I10&","&(2*$D$2+$E$2)/2
Dim myRange As Range
Set myRange = Range("H:H").SpecialCells(xlCellTypeLastCell)
Dim myStr As String
'A=10 is for assigning first row in H as your data, hope no data upward from row 9 to row 1
For Baris = 10 To myRange.Row
On Error Resume Next
myStr = "=$H$10+" & Baris - 9 & "&"",""&B5+I" & Baris & "&"",""&(2*$D$2+$E$2)/2"
Range("K" & Baris).Formula = myStr
Next
End Sub
I'm trying to build a formula that can lookup multiple ISO country codes separated by comma contained in one cell (Cell A2, Image 1) with a reference to a list of country codes and education scoring (Columns F and G, Image 1). Then return the average of the scores of all countries on cell B2. does anyone know if I can build a formula to handle that?
I didn't think you could do this with cell formula, but then I saw this post and came up with this:
=AVERAGE(IF(ISNA(MATCH($F$2:$F$99, TRIM(MID(SUBSTITUTE(A2,",",REPT(" ",99)),(ROW(OFFSET($A$1,,,LEN(A2)-LEN(SUBSTITUTE(A2,",",""))+1))-1)*99+((ROW(OFFSET($A$1,,,LEN(A2)-LEN(SUBSTITUTE(A2,",",""))+1)))=1),99)), 0)), "", $G$2:$G$99 ))
Try pasting into cell B2 as an array formula (Ctrl + Shift + Enter) and fill-down... And don't ask me how it works.
You could try VBA:
Option Explicit
Sub test()
Dim i As Long
Dim strCode As String, strScore As String
Dim rngVlookup As Range
Dim Code As Variant
With ThisWorkbook.Worksheets("Sheet1")
Set rngVlookup = .Range("F2:G34")
For i = 2 To 3
strCode = ""
strScore = ""
strCode = .Range("A" & i).Value
For Each Code In Split(strCode, ",")
If strScore = "" Then
On Error Resume Next
strScore = Application.WorksheetFunction.VLookup(Trim(Code), rngVlookup, 2, False)
Else
On Error Resume Next
strScore = strScore & ", " & Application.WorksheetFunction.VLookup(Trim(Code), rngVlookup, 2, False)
End If
Next Code
With .Range("B" & i)
.Value = strScore
.NumberFormat = "0.000000"
End With
Next i
End With
End Sub
I need to create a VBA script in excel that chanages an order number from having "CD" at the front to "CD" at the end so from "CD00001" to "00001CD"
Any help would be awesome. all of the order numbers are in Column B and start at row 5. please help.
What i have so far:
Private Sub OrderNumber_Click()
Dim Val As String
Dim EndC As Integer
EndC = Worksheets("Raw Data Upload").Range("A1048576").End(xlUp).Row
For i = 5 To EndC
Val = Right("B" & i, Len("B" & i) - 2) & Left("B" & i, 2)
Range("B" & i).Value = Val
Next
End Sub
This replaces the order numbers with B5, B6 and so on but if i put this function into Excel itself it works fine.
Like this? DO you want it in column B?
Option Explicit
Private Sub OrderNumber_Click()
Dim i As Long
Dim val As String
Dim EndC As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Raw Data Upload")
EndC = ws.Range("A1048576").End(xlUp).Row
For i = 5 To EndC
val = ws.Cells(i, "A")
Range("B" & i).Value = Mid$(val, 3, Len(val) - 2) & Left$(val, 2)
Next i
End Sub
dim beginStr, endStr, originalStr, outputStr as string
dim rng as range
'put the below into a loop, assigning a rng to the desired cell each time
originalStr = rng.value ' Change to chosen range
beginStr = left(originalStr,2)
endStr = right(originalStr, len(originalStr) - 2)
outputStr = endStr + beginStr
Range("B" & i).Value = outputStr
I haven't got a copy of Excel to test this on but it should work.
Simply use:
Right(Range("B" & i), Len(Range("B" & i)) - 2) & Left(Range("B" & i), 2)
An alternative is to set up the cell as a Range():
Sub t()
Dim cel As Range
Dim endC As Long
endC = Worksheets("Raw Data Upload").Range("A1048576").End(xlUp).Row
For i = 5 To endC
Set cel = Range("B" & i)
myVal = Right(cel, Len(cel) - 2) & Left(cel, 2)
Range("B" & i).Value = myVal
Next
End Sub
Currently, when you do Right("B" & i, Len("B" & i) - 2) & Left("B" & i, 2), for row 5, this becomes Right("B5", Len("B5") - 2) & Left("B5", 2) then this evaluates to simply:
Right("B5",0) & Left("B5",2), which is
[nothing] & B5, finally becoming
B5
Note the lack of using B5as a range. Instead it's being treated as a string.
(Also, I'm assuming this is to be run on the ActiveSheet. If not, please add the worksheet before the range, i.e. Worksheets("Raw Data Upload").Range("B" & i)...)
Try this
Private Sub OrderNumber_Click()
Dim cell As Range
With Worksheets("Raw Data Upload")
For Each cell in .Range("B5", .Cells(.Rows.Count, 2).End(xlUp))
cell.Value = Right(cell.Value, Len(cell.Value) - 2) & Left(cell.Value, 2)
Next
End With
End Sub
I am having a standard filter on a bunch of columns and i want to read the filter criterias. This wasn't really a problem until the case where more than 2 criteria are selected. I have a row with different strings and i want do be able to get the criteria the user has chosen. Currently I am working with this piece of code:
Set ws = Worksheets(actSheet)
For Each flt In ws.AutoFilter.Filters
If flt.On = True Then
criterias = criterias & flt.Criteria1 & ", "
criterias = criterias & flt.Criteria2 & ", "
End If
Next flt
This only gives me the opportunity to get 2 Criteria max.
I have found this line of code in different forums, but it was used for other reasons and i do not really know how to use this code for me:
ActiveSheet.AutoFilter Field:=1, Criteria1:=Array(param1, param2, param3,...) _
Operator:=xlFilterValues
This way you can set criteria i think, but i want to get it.
Any ideas how i can use this code? Or another suggestion for my problem?
Thanks in advance!
Edit:
Well i've worked a lot of hours on this and still no Solution. It is not really possible to get the Array in Criteria1 in an Array. Always the same Error "Can not assign to array". Although i assigned the same array to the Filter Criteria1 10 lines of code before...
So this works:
Dim arr(3) As String
arr(2) = "test1"
arr(1) = "test2"
arr(3) = "test3"
ActiveSheet.Range("A1:C1").AutoFilter Field:=1, Criteria1:=arr, Operator:=xlFilterValues
But this doesn't:
arr = ws.AutoFilter.Filters.Criteria1
Edit2: This gets the filters and it's headers
Sub GetFilteredItems()
Dim fl As Filter
Dim ws As Worksheet: Set ws = ActiveSheet
Dim i As Long: i = 0
Dim myfilters As String
For Each fl In ws.AutoFilter.Filters
If fl.On Then
If Len(myfilters) = 0 Then
myfilters = ws.AutoFilter.Range.Offset(0, i).Resize(1, 1).Value
Else
myfilters = myfilters & "; " & _
ws.AutoFilter.Range.Offset(0, i).Resize(1, 1).Value
End If
If fl.Count > 2 Then
myfilters = myfilters & ": " & Replace(Join(fl.Criteria1), "=", "")
Else
myfilters = myfilters & ": " & Replace(fl.Criteria1, "=", "")
On Error Resume Next
myfilters = myfilters & " " & Replace(fl.Criteria2, "=", "")
On Error GoTo 0
End If
End If
i = i + 1
Next
Debug.Print myfilters
End Sub
I remove other codes to avoid confusing the reader.
This is much like the OP's approach but a little bit direct. HTH.
Finally i found an answer!
The issue was not too big, just really hard to get an answer on this because you nearly don't find anything on the internet.
Dim criterias As String
Dim arr As Variant
For Each flt In ws.AutoFilter.Filters
If flt.On = True Then
'write the column head in the string
criterias = criterias & "=" & _
ws.AutoFilter.Range.Offset(0, i - 1).Resize(1, 1).Value & ": "
If flt.Count > 2 Then
arr = flt.Criteria1 '<----- my problem
For i = LBound(arr) To UBound(arr) '<-----
criterias = criterias & arr(i) '<-----
Next '<-----
Else
criterias = criterias & flt.Criteria1
On Error Resume Next
criterias = criterias & flt.Criteria2 & ", "
End If
End If
i = i + 1
Next flt
ws is just my active Worksheet
I didn't realise that i should make the array Variant, and not initialise it as a simple String array.
After that the criterias String looks like "Criteria1: =test1=test2=test3", so just replace the "=" with ", " or something like that and you're done!
Axel Richter from a german office board was a big help in this issue ;) (for the german readers: http://www.office-loesung.de/p/viewtopic.php?f=166&t=666472&p=2773974#p2773974)