In Excel, I've written a short script that should remove the first character of each cell containing a "*"symbol at the start of it. What I have so far is
Sub Macro5()
Dim Rng As Range
Dim i As Long
i = 1
While i <= 20000
Set Rng = Range("A" & i)
If InStr(Rng, "*") > 0 Then
Rng.Offset(0, 1).Formula = "=Right(Rng,LEN(Rng)-1)"
i = i + 1
Else: i = i + 1
End If
Wend
End Sub
The line to call the script seems to work, but the formula getting placed into column B is "=Right(Rng,LEN(Rng)-1)", which gives a 'NAME?' error. How do I define the LEN formula to use Rng as a range, rather than as a 'word' on the spreadsheet?
Using R1C1 type formulae makes life much easier in that situation.
Sub RemoveFirstStar()
Dim rng As Range, c As Range
Set rng = Range("A1:A2000")
For Each c In rng.Cells
If Left(c, 1) = "*" Then
c.Offset(0, 1).FormulaR1C1 = "=mid(rc[-1],2,1000)"
End If
Next c
End Sub
For your particular code example, change the line after the IF:
Rng.Offset(0, 1).FormulaR1C1 = "=Right(RC[-1],LEN(RC[-1])-1)"
Related
I have 100.000 records/rows with 17 columns. One of these columns needs to be checked to output either a 1 or 0 to the next column. For this I use a loop with the Instr function, but after 10 mins it still isn't outputting anything on my machine and I believe the code is too intensive or slow running it row for row.
Dim rng As Range
Set rng = Range("F:F")
For Each cell In rng
TicketType = cell
If InStr(1, TicketType, "locker", 1) > 0 Then
cell.Offset(0, 1) = 1
Else
cell.Offset(0, 1) = 0
End If
Next
There are only 100 TicketTypes to check however, and based on the names of these TicketTypes it should output a 1 or 0 (match or not). So I was thinking, maybe there is a way to sort the entire table, run through it to see which categories there are, store their vertical ranges, run a check and then output +-10.000 rows at once? I noticed this is instant, so I believe it's really the Instr function that is the bottleneck.
Try this:
Dim rng As Range, f
With ActiveSheet
Set rng = Application.Intersect(.Columns("F"), .UsedRange)
f = "=--NOT(ISERROR(SEARCH(""locker""," & rng(1).Address(False, False) & ")))"
Debug.Print f
rng.Offset(0, 1).Formula = f
rng.Offset(0, 1).Value = rng.Offset(0, 1).Value
End With
Variant array approach
As mentioned by BigBen it's faster than looping through each cell by means of VBA.
Sub VariantArray()
With Sheet1
'~~> Set you relevant range here
Dim lastRow As Long, rng As Range
lastRow = .Range("F" & .Rows.Count).End(xlUp).Row
Set rng = .Range("F1:F" & lastRow)
'~~> create a one based 2-dim datafield array
Dim myArray As Variant
myArray = rng
'~~> check TicketType
Dim i As Long
For i = 1 To UBound(myArray)
myArray(i, 1) = IIf(InStr(1, myArray(i, 1), "locker", 1) > 0, 1, 0)
Next i
'~~> fill target with array values
rng.Offset(0, 1) = myArray
End With
End Sub
you could try filtering:
With Worksheets("actualSheetName") '<-- change "actualSheetName" to your actual sheet name
With .Range("F1", .Cells(.Rows.Count, "F").End(xlUp))
.Offset(, 1).Value = 0
.AutoFilter Field:=1, Criteria1:="*locker*"
.SpecialCells(xlCellTypeVisible).Offset(, 1) = 1
End With
.AutoFilterMode = False
End With
As suggested by BigBen, a far better solution is the usage of a worksheet function, like Find.All() (at least that how I think it's called). If it finds something, it gives a number, else it gives an error. You might turn this into an interesting formula like this:
=IF(IF.ERR(FIND.ALL("locker";A2);0)=0;0;1)
I am working on an Excel document using VBA. This document contains a database with multiple columns, but for simplicity, let's say I have 2 columns:
Column C corresponds to names
Column F corresponds to numbers.
I'm trying to create a macro that checks all the numbers in column F (with a loop). If the number is above 100, then check the adjacent cell in column C. If the name corresponds to a condition (let's say corresponds to John or Tom), then add the value of the number in another sheet. If none of those apply, check the next cell.
My problem is that I can't find a way to define the cells in column C (Creating a variable/object to call the cells or calling directly the adjacent cell).
My code looks like this:
Sub Test1()
Dim rngnumbers, rngnames, MultipleRange As Range
Set rngnumbers = Sheet2.Range("F2:F999")
Set rngnames = Sheet2.Range("C2:C999")
Set MultipleRange = Union(rngnumbers, rngnames)
For Each numb In rngnumbers
If numb.Value >= 100 Then
If Sheet2.Range("C2") = "John" Or Sheet2.Range("C2") = "Tom" Then '''The problem here is that it only looks at the cell C2 and not the adjacent cell
Sheet1.Range("I999").End(xlUp).Offset(1, 0).Value = numb.Value
Else
End If
End If
Next numb
End Sub
I tried modifying the line:
'If Sheet2.Range("C2") = "John" Or Sheet2.Range("C2") = "Tom" Then'
to something like:
'newname.String = "John" '
But I can't find a way to define newname.
Another idea would be to increment the If statement for the names within the For loop.
Additional note:
I am also not using formulas directly within Excel as I don't want any blank cells or zeros when the if functions are False.
Does this solve your problem - referencing the relevant cell in column C? OFFSET provides a relative reference, in this case look 3 columns to the left of F.
Sub Test1()
Dim rngnumbers As Range, rngnames As Range, MultipleRange As Range, numb As Range
Set rngnumbers = Sheet2.Range("F2:F999")
Set rngnames = Sheet2.Range("C2:C999")
Set MultipleRange = Union(rngnumbers, rngnames)
For Each numb In rngnumbers
If numb.Value >= 100 Then
If numb.Offset(, -3) = "John" Or numb.Offset(, -3) = "Tom" Then
Sheet1.Range("I999").End(xlUp).Offset(1, 0).Value = numb.Value
End If
End If
Next numb
End Sub
Have you considered SUMIFS instead?
You want something like this?
Sub Test1()
Dim lRow As Long, r As Long
lRow = 1000 'last row in your data
Dim ws As Worksheet
Set ws = Worksheets("List with your data")
For i = 2 To lRow
If ws.Range("F" & i) > 100 Then
If ws.Range("C" & i).Value = "John" Or ws.Range("C" & i).Value = "Tom" Then
Worksheets("Another sheet sheet").Range("A" & r) = Range("C" & i).Value ' r - Row, where we want to enter uor text
r = r + 1 'if you want to put next name on the next row
End If
End If
Next
End Sub
Two Ifs in a Loop
Union Version
Option Explicit
Sub Test1()
Const cFirst As Integer = 2
Const cLast As Integer = 999
Const cCol1 As Variant = "F"
Const cCol2 As Variant = "C"
Const cCol3 As Variant = "I"
Dim i As Integer
Dim rngU As Range
With Sheet2
For i = cFirst To cLast
If IsNumeric(.Cells(i, cCol1)) And .Cells(i, cCol1) >= 100 Then
If .Cells(i, cCol2) = "John" _
Or .Cells(i, cCol2) = "Tom" Then
If Not rngU Is Nothing Then
Set rngU = Union(rngU, .Cells(i, cCol1))
Else
Set rngU = .Cells(i, cCol1)
End If
End If
End If
Next
End With
If Not rngU Is Nothing Then
rngU.Copy Sheet1.Cells(cLast, cCol3).End(xlUp).Offset(1, 0)
Set rngU = Nothing
End If
End Sub
I normally work with arrays:
Sub Test1()
Dim rngnumbers As Excel.Range
Dim arrVals As variant
Dim lngRow As long
Arrvals = Sheet2.Range("C2:F999").value
For Lngrow = lbound(arrvals,1) to ubound(arrvals,1)
If arrvals(lngrow,4) >= 100 Then
If arrvals(lngrow,1)= "John" Or arrvals(lngrow,1) = "Tom" Then '''The problem here is that it only looks at the cell C2 and not the adjacent cell
Sheet1.Range("I999").End(xlUp).Offset(1, 0).Value = arrvals(lngrow,4)
Else
End If
End If
Next lngrow
End Sub
Actually I would probably build an output array as well, but my thumb is tired...
I have the following code to find the first blank cell and sum the data below it at the last blank cell.
Dim r As Range
Dim lngRowStart As Long
If Range("A1").Formula <> "" Then
lngRowStart = 1
Else
lngRowStart = Range("A1").End(xlDown).Row
End If
Set r = Cells(lngRowStart, 1).End(xlDown).Offset(1, 0)
If Left(r.Offset(-1, 0).Formula, 1) <> "=" Then
r.FormulaR1C1 = "=Subtotal(9,R[-" & r.Row - lngRowStart & "]C:R[-1]C)"
End If
But this assumes that the data is in column A and for the first set of continuous data, how to modify it for any active cell to sum the above continuous data?
For example:
2
4
3
Blank (SUM ABOVE=9)
1
3
2
Blank (SUM ABOVE=6)
You can use the UDF below (explanation inside the code's comments):
Function SumContinRange(CurCell As Range) As Double
Dim RngStart As Range, SumRng As Range
If CurCell <> "" Then
' find the first empty cell using the Find function
Set RngStart = Columns(CurCell.Column).Find(what:="", After:=CurCell, LookIn:=xlValues)
Else
' find the first empty cell using the Find function
Set RngStart = Columns(CurCell.Column).Find(what:="", After:=CurCell, LookIn:=xlValues, SearchDirection:=xlPrevious)
End If
' set the Sum Range
Set SumRng = Range(RngStart.Offset(-1, 0), RngStart.Offset(-1, 0).End(xlUp))
SumContinRange = WorksheetFunction.Sum(SumRng) ' return this value
End Function
Then, test it by passing the ActiveCell using the Sub below:
Sub TestFunc()
If ActiveCell.Value <> "" Then
ActiveCell.End(xlDown).Offset(1) = SumContinRange(ActiveCell)
Else
ActiveCell = SumContinRange(ActiveCell)
End If
End Sub
So I'm fairly new to VBA, and I have been struggling with trying to get my macro to work.
Essentially what I'm trying to do is have a program read down a column, and for every "X" located in that column, the corresponding hyperlink in the adjacent column will be selected.
Sub Select_Hyperlinks()
Dim rng As Range, cell As Range, sel As Range
Dim sht As Worksheet
For x = 1 To 6
Set sht = Sheets("Generator")
Set sel = cell.Offset(-1, 0)
Set rng = Intersect(sht.Range("D4:D9"), sht.UsedRange)
For Each cell In rng.Cells
If (cell.Value) <> "X" _
Then
If sel Is Nothing Then
Set sel = cell.Offset(-1, 0)
sel.Select
End If
Next cell
End If
Next x
End Sub
I also tried a simpler idea using the Find and FindNext functions and for each X, I tried to get it to select and activate the cell in the adjacent column, but also with no luck. It seems I always get snagged up on the .Offset function.
EDIT:
Here's what I've managed to come up with, after some further research. I've adapted this from a macro designed to delete all empty rows.
Sub AutoOpen()
Dim xlastcell As Integer
Dim xcell As Integer
xcell = 1
Range("C200").End(xlUp).Select
xlastcell = ActiveCell.Cells 'This used to say ActiveCell.Row but I want a single cell'
Do Until xcell = xlastcell
If Cells(xcell, 1).Value = "X" Then
Cells(x, 1).Select
ActiveCell.Offset(0, -1).Select 'I'm also unable to get this function to work'
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
xcell = xcell - 1
xlastcell = xlastcell - 1
End If
xcell = xcell + 1
Loop
End Sub
Are you saying that if there is an X in the one column, you want to open the hyperlink?
EDIT:
Use this and change things to match your variables.
Sub asdhkl()
Dim c As Hyperlink
Dim i As Range
For Each i In Sheets(1).Range("b1:b3")
If i = "x" Then
Set c = i.Offset(0, -1).Hyperlinks(1)
c.Follow
End If
Next i
End Sub
I have a column of data in excel. I want to loop through the data and combine the contents into a single string. I can specify the cell range, but what if the range is unknown. I want to be able to loop until the cell becomes empty. here is what I have so far.
Sub ConcatenationLoop()
Dim rng As Range, i As Integer
Set rng = Range("A1", "A5")
For i = 1 To rng.Rows.Count
With Range("B1")
If .Value = "" Then
.Value = rng.Range("A" & i)
Else
.Value = .Value & ", " & rng.Range("A" & i)
End If
End With
Next
is it possible to combine with something like:
Do Until IsEmpty(ActiveCell)
Much help is appreciated!
End Sub
With Worksheets("YourSheetName")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Loop it to LastRow.
Get the first empty cell from the top using
lLastRow = sheet.Cells(1, 2).End(xlDown).Row
The use this in your for loop
For i = 1 To lLastRow
You could use the following skeleton:
Sub ALoop()
Dim r As Long
r = 2 '//Start row
While Len(Cells(r, "A")) > 0 '//Or While Not IsEmpty(...)
'// Your code
r = r + 1 '//Don't forget to increment row
Wend
End Sub