Hello I am new to VBA and I have an excel sheet as shown in the image below and I want to run through each row until the last row to remove the characters in front of "/".
The following is my VBA code. However, my code could only work on one cell currently and I am not sure how do I change it to a For Loop to run through all the rows until the last row. Also, there are certain cells that does not contain the "/" and I just want it to be an empty cell. I need some help on how could I work on this? Thank you really appreciate if anyone would be able to assist me with this.
Sub String()
' String
Dim stringOriginal As String
stringOriginal = Range("A2").Value
Dim indexOfThey As Integer
indexOfThey = InStr(1, stringOriginal, "/")
Dim finalString As String
finalString = Right(stringOriginal, Len(stringOriginal) - indexOfThey)
Range("A2").Value = finalString
End Sub
Try following sub
Sub StringOperation()
Dim lRow As Long
Dim Rng As Range
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each Rng In Range("A1:A" & lRow)
If (InStr(1, Rng, "/")) > 0 Then
Rng = Right(Rng, Len(Rng) - InStr(1, Rng, "/"))
End If
Next
End Sub
Edit: To empty cells that doesn't contain / use below codes.
Sub StringOperation()
Dim lRow As Long
Dim Rng As Range
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each Rng In Range("A1:A" & lRow)
If (InStr(1, Rng, "/")) > 0 Then
Rng = Right(Rng, Len(Rng) - InStr(1, Rng, "/"))
Else
Rng = ""
End If
Next
End Sub
Related
I want to fill blank cells in sequential order based on the cell above.
The interval to be filled for column F is not consistent. Need to fill down two up to 20 rows based on the item number above.
Need VBA and not a formula.
This code would copy the item above the non blank and paste it down.
Sub FillBlanks()
Columns("F:F").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
End Sub
What I need is to autofill in sequence until the next nonblank.
Something like:
OA205S061169
OA205S061170
OA205S061171
OA205S061172
OA205S061173
OA205S061174
You can select your blank cells, as you are already doing, and then loop through each area, as follows...
Sub FillBlanks()
Dim lastRow As Long
Dim dataRange As Range
Dim currentArea As Range
lastRow = Cells(Rows.Count, "F").End(xlUp).Row
On Error Resume Next
Set dataRange = Range("F1:F" & lastRow).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not dataRange Is Nothing Then
For Each currentArea In dataRange.Areas
With currentArea
With .Offset(-1, 0).Resize(.Rows.Count + 1)
.Cells(1).AutoFill Destination:=.Cells, Type:=xlFillDefault
End With
End With
Next currentArea
End If
End Sub
Note that it uses Column F to find the last used row. However, depending on your data, you'll likely need to use some other column to determine the last used row. To use Column A, for example, use the following instead...
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Try
Sub FillTest()
Dim rngDB As Range
Dim vDB, vSplit
Dim i As Long, x As Long, n As Integer
Dim s As String
Set rngDB = Range("f1", Range("f" & Rows.Count).End(xlUp))
vDB = rngDB
For i = 1 To UBound(vDB, 1)
If vDB(i, 1) <> "" Then
vSplit = Split(vDB(i, 1), "S")
s = vSplit(0) & "S"
x = vSplit(1)
n = 0
Else
n = n + 1
vDB(i, 1) = s & Format(x + n, "000000")
End If
Next i
rngDB = vDB
End Sub
I'm trying to create a macro which is supposed to check for a number of range to find out if there are multiple items separated by semicolon ; within certain cells. If it finds one then the macro will count how many times that sign ; has appeared in each cell:
For example, in Range("A1") that sign has appeared 3 times:
apple;orange;guava;malta
I've tried so far:
Sub DistributeItemsToColumns()
Dim cel As Range
For Each cel In Range("A1:L4")
If InStr(cel, ";") > 0 Then
Debug.Print cel 'can't think further
End If
Next cel
End Sub
Try:
Option Explicit
Sub test()
Dim LastRow As Long, i As Long, arr As Variant
Dim NumberOfOccu As Long
With ThisWorkbook.Worksheets("Sheet1")
'Find last row of column A
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Loop from row 1 to lastrow
For i = 1 To LastRow
If InStr(.Range("A" & i).Value, ";") Then
'Number of characters
NumberOfOccu = InStr(.Range("A" & i).Value, ";")
arr = Split(.Range("A" & i).Value, ";")
.Range("C" & i).Resize(, UBound(arr) + 1) = arr
End If
Next i
End With
End Sub
Results:
I am still new to coding so i apologise if i dont understand everything.
I need to check each cell of D3:D5000 if they start with GUF. Then remove the GUF from it. Else dont do anything.
This is what ive been trying to use but im getting an error Do ohne Loop:
Sub RemoveGUFfromcellsstartingwithGUF()
Range("D3").Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveCell = "end"
Range("B1").Select
Do Until ActiveCell = "end"
If ActiveCell = "GUF*" Then
ActiveCell.Value = Mid(Cell, 4, 999999)
End If
ActiveCell.Offset(1, 0).Select
End Sub
Thanks for any help/suggestions
Firstly, when you are looping through cells, it's best to use For each cell in cells, no need to change selection then.
Firstly, set a range in which you want it to run.
Sub RemoveGUFfromcellsstartingwithGUF()
dim first_cell as Range
dim last_cell as Range
dim rng as Range
set first_cell = ActiveSheet.Range("D1") 'first cell of your range
set last_cell = ActiveSheet.Range("D5000") 'last cell of your range
set rng = Range(first_cell, last_cell) 'range from first_cell to last_cell
For Each cell in rng.cells 'looping through cells of the range
'What you do here will be done to every cell.
if left(cell.value, 3) = "GUF" then cell.value = Mid(cell.value,4)
Next cell
End Sub
I hope this helps.
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, i As Long
Set ws = Sheet1 '<~~ Change this to the relevant sheet
With ws
'~~> Find last row in Col D
lRow = .Range("D" & .Rows.Count).End(xlUp).Row
'~~> Loop through cell in Col D
For i = 3 To lRow
If .Range("D" & i).Value Like "GUF*" Then
.Range("D" & i).Value = Mid(.Range("D" & i).Value, 4)
End If
Next i
End With
End Sub
Every part of my code works thus far, I just want to edit one part. I have my macro searching through a filtered range to see if it contains "CHECKED IN" and "CHECKED OUT".
However I want to add many more words to check for. Is there any way I can change this code to perhaps make an array of strings that each cell is searched for?
I suppose I can add a lot of "if or"s, but that isn't fun.
Sub checkk()
Dim cl As Range, rng As Range
Dim LastRow As Long
Dim celltxt As String
Dim i As Integer
i = 1
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Set rng = Range("A1:A" & LastRow)
For Each cl In rng.SpecialCells(xlCellTypeVisible)
cl.Select
celltxt = ActiveCell.Text
If InStr(1, celltxt, "CHECKED OUT") Or InStr(1, celltxt, "CHECKED IN") Then
MsgBox ("found it")
else
MsgBox ("no")
End If
Next cl
If i > 1 Then
MsgBox ("Looks like you have to do some more filtering, sort column A by
color to see what was tagged")
End If
End Sub
Yes of course you can create array and loop through array
Sub checkk()
Dim cl As Range, rng As Range
Dim LastRow As Long
Dim celltxt As String
Dim arrVarToCheck(2) As Variant
arrVarToCheck(0) = "CHECKED OUT"
arrVarToCheck(1) = "CHECKED IN"
arrVarToCheck(2) = "Foo"
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Set rng = Range("A1:A" & LastRow)
For Each cl In rng.SpecialCells(xlCellTypeVisible)
celltxt = cl.Text
For i = 0 To UBound(arrVarToCheck)
If InStr(1, celltxt, arrVarToCheck(i)) Then
MsgBox ("found it")
Else
MsgBox ("no")
End If
Next i
Next cl
End Sub
In excel 2010, how to do a validation if cell contain ',' then pop up a message to user ?
Please try to show your work ..
lets say Column A contains the data then below code work perfectly
this is what u wanted (TESTED)
Sub tested()
Dim erange As Range
Dim lrow As Integer
lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For Each erange In Range("A2:A" & lrow)
If InStr(erange.Value, ",") > 0 Then
MsgBox (erange.Address & " contains Comma ")
erange.Interior.Color = vbRed
End If
Next erange
End Sub
Using normal data validation, you could try this
=(LEN(A1) = LEN(SUBSTITUTE(A1,",","")))
If you want to avoid unnecessary loop use below code.
Sub findComma()
Dim srcRng As Range, findRng As Range
Dim firstCell As String
Dim lrow As Integer
lrow = Range("A" & Rows.Count).End(xlUp).Row
Set srcRng = Range("A1:A" & lrow)
Set findRng = srcRng.Find(What:=",", LookIn:=xlValues, LookAt:=xlPart)
If Not findRng Is Nothing Then firstCell = findRng.Address
Do Until findRng Is Nothing
MsgBox (findRng.Address & " contains Comma ")
findRng.Interior.Color = vbRed
Set findRng = srcRng.FindNext(findRng)
If findRng.Address = firstCell Then Exit Sub
Loop
End Sub