I am trying to get some text between two words from a column of similar data, so far I have:
Dim I As Integer
For I = 1 To 989
thisSTRING = Worksheets(1).Range("A" & I).Value
ref = Split(Split(thisSTRING, "RING ")(1), " EM")(0)
Worksheets(1).Range("B" & I).Value = ref
Next I
The problem I have is that not all text in the column is the same and when I reach such a point in the for loop I get an error message as there is either no "RING" or "EM", to avoid this I tried to use "on error resume next". This worked but it duplicates in the cells which had the errors. Is there any simple method for making this skip the cell/leave it blank instead of creating a duplicate?
Here's what I was thinking:
Sub PrintSplit()
Dim ws As Excel.Worksheet
Dim i As Long
Dim thisSTRING As String
Dim ref As String
Set ws = ThisWorkbook.Worksheets(1)
For i = 1 To 989
thisSTRING = ws.Range("A" & i).Value
If InStr(thisSTRING, "RING ") > 0 And InStr(thisSTRING, " EM") > 0 Then
ref = Split(Split(thisSTRING, "RING ")(1), " EM")(0)
ws.Range("B" & i).Value = ref
End If
Next i
End Sub
This assumes that you want a blank if either of the strings are missing. If you only wanted it if both strings are missing the logic would be different, but similar.
Note that I changed i to a Long which is a good practice, as it's the native type for whole numbers and will accommodate larger values. I also created a worksheet variable, just to make it a little more flexible, and to get Intellisense.
Related
I have 20 cases. For every row in my sheet, I have a cell that assigns related case numbers to it. A row could have multiple case numbers assigned to it in that cell (Example: 1,2,11,12)
I am writing a code to copy all the rows that have Case number 1 assigned to them, copy them someplace else..
and then go to case number 2 and repeat the same..
This is what I am using:
For CaseNumbers = 1 To 20
For i = Row1 To RowLast
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
COPY AND PASTE CODE
End If
Next
Next
The problem I am facing is, the code considers case number 11 as case number 1 too (since it has the digit 1).
This is the first time I am writing a VBA code and I have no background in this.
Can someone please advise on better way of doing this? Should I assign a checklist instead to each row?
All I want to do is find all the rows that have Case number 1 assigned, copy them.. then find all the rows that have Case 2 assigned, copy them.. and so on.
Please help.
You can use a function to do the test
Public Function isCaseNumberIncluded(ByVal caseToCheck As Long, ByVal caseNumbers As String) As Boolean
'add , to make all values distinct
caseNumbers = "," & caseNumbers & ","
Dim strCaseToCheck As String
strCaseToCheck = "," & caseToCheck & ","
If InStr(1, caseNumbers, strCaseToCheck) > 0 Then
isCaseNumberIncluded = True
End If
End Function
You would call this function within your main code like this:
Dim caseNumber As Long 'I removed the s - as this could be misleading in my eyes
For caseNumber = 1 To 20
For i = Row1 To RowLast
If isCaseNumberIncluded(caseNumber, Range(CaseNoCell & i).Value) Then
COPY AND PASTE CODE
End If
Next
Next
Using a separate function to run the test has two advantages:
your code gets more readable, ie you know from reading the functions name what the result should be - without reading the whole code how to do it :-)
you can re-use this code propably at another place
Or you can test the function first:
Public Sub test_isCaseNumberIncluded()
Debug.Print isCaseNumberIncluded(1, "1,2,11,12"), "Should be true"
Debug.Print isCaseNumberIncluded(1, "2,11,12"), "Should be false"
Debug.Print isCaseNumberIncluded(11, "1,2,11,12"), "Should be true"
Debug.Print isCaseNumberIncluded(11, "1,2,12"), "Should be false"
End Sub
Well, you are working with this piece of code:
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
This checks against 1,, 12,, ..., but obviously it won't cover the last entry so that's something you'll need to add. And you have the problem that 11, gets treated as 1,.
In a similar way you can use this piece of code:
If InStr(1, Range(CaseNoCell & i).Value, "," & CaseNumbers & ",") Then
This checks against ,1,, ,12,, ... so it will solve your error, but obviously it won't cover the last and the first entry so that's something you'll need to add.
This is something that should be encapsulated in a function rather than being done in line. The method provided in VBA for tokenising a string is 'Split'.
You could wite a function that checks tokens 1 by 1, or which compile a collection of the tokens which then uses a built checking method of the collection to determine if the specified token is present or not.
In this specific case I've chosen to use the collection method. The specific object for the collection is the ArrayList (but a Scripting.Dictionary is also possible). The function contains checks for zero length strings and allows the seperator to be specified if it isn't a comma.
Option Explicit
Function FindToken(ByVal ipToken As String, ByVal ipTokenList As String, Optional ByVal ipSeparator As String = ",") As Boolean
' Guard against ipSeparator being vbnullstring
Dim mySeparator As String
mySeparator = IIf(VBA.Len(ipSeparator) = 0, ",", ipSeparator)
'Raise an error if ipToken or ipTokenList are empty strings
If VBA.Len(ipToken) = 0 Or VBA.Len(ipTokenList) = 0 Then
Err.Raise 17, "Empty string error"
End If
'Convert the token list to tokens
Dim myTokens As Variant
myTokens = VBA.Split(ipTokenList, mySeparator)
' Put the tokens in an ArrayList so we can use the contains method
' no point is doing early binding as arraylist doesn't provide intellisense
Dim myAL As Object
Set myAL = CreateObject("System.Collections.ArrayList")
Dim myItem As Variant
For Each myItem In myTokens
' Trim just in case there are spaces
myAL.Add VBA.Trim(myItem)
Next
'Finally test if the Token exists in the token list
Find = myAL.contains(VBA.Trim(ipToken))
End Function
This means that your code
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
can now be rewritten as
If FindToken(CStr(CaseNUmbers), Range(CaseNoCell & cstr(i)).Value) Then
Identify Criteria Rows
Option Explicit
Sub Test()
Const WordSeparator As String = ","
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim CaseNumber As Long
Dim i As Long
Dim cValue As Variant
Dim cString() As String
For CaseNumber = 1 To 20
For i = Row1 To RowLast
cValue = CStr(ws.Range(CaseNoCell & i).Value)
If Len(cValue) > 0 Then
cString = Split(cValue, WordSeparator)
If IsNumeric(Application.Match( _
CStr(CaseNumber), cString, 0)) Then
' CopyAndPasteCode CaseNumber
Debug.Print "Case " & CaseNumber & ": " & "Row " & i
End If
End If
Next i
Next CaseNumber
End Sub
I am having a problem with a particular line of code:
ActiveSheet.Range("A" & rowCount & ":" & Mid(alphabet, totHdrLngth, 1) & belowRowCount)
Where alphabet is a string containing uppercase letters A to Z.
I keep getting the following error:
Run-time error '5':
Invalid Procedure call or argument
I tried creating a String "inRange" and changing the code to this:
inRange = "A" & rowCount & ":" & Mid(alphabet, totHdrLngth, 1) & belowRowCount
curRange = ActiveSheet.Range(inRange)
But that did not help (as I thought it wouldn't). Any suggestions?
Although creating ranges like this is frowned upon in general, the way to do it is with the word SET (like #Gary McGill stated in the comments). Here is an example of how to do this:
Sub test()
Dim alphabet As String
Dim totHrdrLngth As Long
Dim belowRowCount As Long
Dim rowCount As Long
Dim inRange As Range
alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
totHrdrLngth = 5
belowRowCount = 10
rowCount = 5
' Gives us A5:E10
Set inRange = Range("A" & rowCount & ":" & range2 & _
Mid$(alphabet, totHrdrLngth, 1) & belowRowCount)
End Sub
You are running this macro in the current range, so there should be no need to specify ActiveSheet.Range. I hope this helps get you toward what you are trying to achieve.
As far as I can tell, you're getting an error because your types don't match up. I imagine rowCount is an integer, as is belowRowCount. If you convert them to strings before concatenating them, you can fix it. str() will convert an integer to a string with a space before it, and LTrim() will remove the space. Try code as below:
Dim sRowCount As String
Dim sBelowRowCount As String
and later
sRowCount = LTrim(Str(RowCount))
sBelowRowCount = LTrim(Str(belowRowCount))
inRange = "A" & sRowCount & ":" & Mid(alphabet, totHdrLngth, 1) & sBelowRowCount
curRange = ActiveSheet.Range(inRange)
Hope this helps.
I was tasked with creating a code that will check to see if internal hyperlinks in an excel spreadsheet worked. This code first changes the formulas that were on the spreadsheet and makes them actual hyperlinks (they were originally formulas linking the locations together). The problem that I have now is that I want to create hyperlinks ONLY if Column S has text. If it doesn't, I don't want the "E-COPY" text to be displayed. All of the text in Column S varies (not one line has the same characters), which is why I'm drawing a blank is to how I tell the program to only continue if it has any text, not anything specific. I am working with Excel 2016.
Also, I am doing this to 71935 and counting rows; is there a limit to how many it can go through? If so, what can I do about it?
Thank you!
Sub CreateHyperlinks()
Dim FN As Variant
Dim Path As Variant
Dim count As Variant
Sheets(1).Activate
count = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
For i = 2 To count
If Range("AM" & i).Value = "Yes" And Columns("S") = Then
Range("E" & i).Value = ""
Path = Sheets(1).Range("R" & i).Value
FN = Sheets(1).Range("S" & i).Value
Sheets(1).Range("E" & i).Select
Selection.ClearFormats
Selection.Hyperlinks.Add Anchor:=Selection, Address:=Path & FN, TextToDisplay:="E-COPY"
Range("AM" & i).Value = " "
End If
Next i
End Sub
If you just need to check for any content in ColS then:
If Range("AM" & i).Value = "Yes" And Len(Range("S" & i).Value) > 0 Then
Few things:
'make a reference to the sheet you're working with
Dim ws As Worksheet
Dim wb As Workbook
Set wb = Excel.Application.ThisWorkbook
Set ws = wb.Worksheets(1)
'gets the absolute last row with data in it // ignores empty cells
count = ws.UsedRange.Rows.Count
personally, i hate working with named ranges, so i would suggest setting range references like so
what you wrote
Path = Sheets(1).Range("R" & i).Value
what i believe it should look like
Path = ws.Cells(i, 18).Value
if you want to test the type when working with variants, try this:
'tests the type associated with the variant. an 8 = string
If VarType(ws.Cells(i, 19).Value) = 8 Then
'do your thing
'tests if the value is null
ElseIf VarType(ws.Cells(i, 19).Value) = 0 Then
'do your other thing
here's a list of the vartype enumeration to help you out.
hope it helps!
It's my first time writing a code that actually attempts to do something and I'm having some trouble with writing an error handler. The code attempts to match 'tosearch' to the range I1:I10. If it finds a match and the cell is blank is asks for user input.
Obviously there is a problem in matching with loops as the loop will break at the slightest sniff of a mismatch. I attempted to solve this with the 'If iserror(etc.)' but I still get mismatch error type 13 and the debugger points me to this line
If IsError(myvalue = Application.Match(tosearch, Range("i1:i10"), 0)) Then
Please ignore the horrendous, sprawling mess beneath. It works (just) and while it doesn't have any practical use yet, i hope to use it to quickly identify matches between arrays but also have some control over whether the 'correct' match is displaying the right information.
If anyone has any answers your help would be hugely appreciated.
Dim myvalue As String
Dim myrng As Long
Dim tosearch As String
Dim myrnglimit As Long
Dim Uchoose As String
Dim animal As Variant
Dim blankchck As String
myrnglimit = 15
For myrng = 2 To myrnglimit
'isblank check
blankchck = Range("c" & myrng).Value
If blankchck = "" Then
'sets tosearch as each cell
tosearch = Range("a" & myrng).Value
'error checker then it matches each cell to the table hardcoded into the code
If IsError(myvalue = Application.Match(tosearch, Range("i1:i10"), 0)) Then
GoTo nextloop:
Else
myvalue = Application.Match(tosearch, Range("i1:i10"), 0)
'fills in the second column with Animal data
animal = Range("j" & myvalue).Value
Range("a" & myrng).Offset(0, 1).Value = animal
'User input for animal
Uchoose = MsgBox("Excel says : " & Range("k" & myvalue).Value & ". So are " & animal & " good?", vbYesNoCancel, "Status")
If Uchoose = vbYes Then
Range("a" & myrng).Offset(0, 2).Value = "Good"
ElseIf Uchoose = vbNo Then
Range("a" & myrng).Offset(0, 2).Value = "Bad"
ElseIf Uchoose = vbCancel Then
GoTo nextloop:
End If
'Select case to identify 1004 mismatch and skip
nextloop:
'Error checker if
End If
'Avoidblank if
End If
Next myrng
I think the problem may be caused because there is a difference between the data types in your range and the string variable toSearch. I'd recommend settting toSearch as follows:
Dim tosearch As Variant
The following link describes a similar problem and a similar solution to the one I have defined here.
http://www.excelforum.com/excel-programming-vba-macros/358571-application-match.html
this is my first time using the site, so forgive me for any inept explaining. I have a working macro to hide/unhide rows based on content of the rows, I just want it to be faster. Using a check box, when the box is checked, all rows with an "x" in column D get unhidden, those without an "x" get hidden. Same thing happens when it is unchecked, except it references column C, not D.
Right now, this code works. It's just a little slower than I'd like, since I'm sharing this with a bunch of people. Any ideas for how to speed it up? I'm pretty darn new to VB (the internet is astoundingly wise and a good teacher), but that doesn't matter. I already improved the code - before it selected each row, then referenced the column, and it was awful. Any ideas to speed it up (preferably without moving the screen) would be great.
Thanks so much folks,
DS
Sub NewLuxCheck()
Dim x As Integer
NumRows = Range("A42", "A398").Rows.Count
Range("A42").Select
If ActiveSheet.Shapes("checkbox2").OLEFormat.Object.Value = 1 Then
For x = 42 To NumRows + 41 Step 1
If Worksheets("Base").Range("D" & x).Value = "x" Then
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = False
Else
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = True
End If
Next
Else
For x = 42 To NumRows + 41 Step 1
If Worksheets("Base").Range("C" & x).Value = "x" Then
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = False
Else
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = True
End If
Next
End If
MsgBox ("Done")
End Sub
You could use array formula and let Excel to return array with row-numbers where 'x' value occures. It will be quicker but you'll have to reorganise your code and create separate functions etc.
Here example where array formula finds rows whre in column 'D' the cell has value 'x'. Then string of this row numbers is created in form of "A1,A5,A10" ...means 'x' was found in rows 1,5,10. And finally Range(rowsJoind).EntireRow.Hidden is used for all the rows to be hidden/un-hidden in one step.
For rows with value different then 'x' you'll have to use formula like '=IF({0}<>""x"", ROW({0}), -1)'.
Sub test()
Dim inputRange As Range
Dim lastRow As Long
Dim myFormula As String
Dim rowsJoined As String, i As Long
Dim result As Variant
With Worksheets("Base")
lastRow = .Range("D" & .Rows.Count).End(xlUp).Row
Set inputRange = .Columns("D").Resize(lastRow)
Application.ReferenceStyle = xlR1C1
myFormula = "=IF({0}=""x"", ROW({0}), -1)"
myFormula = VBA.Strings.Replace(myFormula, "{0}", inputRange.Address(ReferenceStyle:=xlR1C1))
result = Application.Evaluate(myFormula)
result = Application.Transpose(result)
Application.ReferenceStyle = xlA1
For i = LBound(result) To UBound(result)
If (result(i) > -1) Then
rowsJoined = rowsJoined & "A" & result(i) & IIf(i < UBound(result), ",", "")
End If
Next i
.Range(rowsJoined).EntireRow.Hidden = False
End With
End Sub