Currently working on a script to highlight a row if a specific cell within the row contains a certain phrase (the cell contains more than just the specific phrase). However, when trying to test, I am seeing the error "Compile Error: End With without With" I can see both the With and End With in my code, although it is possible I have been looking at this for too long to notice the obvious. Can anyone notice anything that could be causing this within the code?
Sub Conversion()
Dim State As String
Dim County As String
Dim Date As String
Dim TC As String
Dim H As String
Dim Tmp As String
Dim m As Long
Dim x As Long
H = "not recognised"
With Sheets("Matched Date")
For Each cell In Sheet
m = UBound(Split(Rng.Value, H))
If m > 0 Then
Tmp = ""
For x = 0 To m - 1
Tmp = Tmp & Split(Rng.Value, H)(x)
.Characters(Start:=Len(Tmp) + 1, Length:=y).EntireRow.Color = RGB(252, 227, 3)
Tmp = Tmp & H
Next
End If
End With
Edit: Sorry about the amateurish code here, I'm not trained, just trying to do this based off simple online videos and google guides, as we have noone else to do this for us.
As mentioned above already, proper code indention is your friend. Doing so, your code looks like
With Sheets("Matched Date")
For Each cell In Sheet
m = UBound(Split(Rng.Value, H))
If m > 0 Then
Tmp = ""
For x = 0 To m - 1
Tmp = Tmp & Split(Rng.Value, H)(x)
.Characters(Start:=Len(Tmp) + 1, Length:=y).EntireRow.Color = RGB(252, 227, 3)
Tmp = Tmp & H
Next
End If
End With
That way, it's easy to spot that your 1st For loop is missing the closing Next.
This and similar error messages can be a bit misleading. It basically means "This code somehow misses a closing 'bracket'", if you think of the pairs With/End With, For/Next, Select/End Select etc. as opening/closing bracket pairs.
Related
I have a list that was copied from a 'table of contents' page to column D. Unfortunately, each cell contains the chapter number, chapter name, and the page number.
3.14.4 chapter name placeholder.140
Sometimes there is a space between the page number and the last character. other times there is not.
I've tried
Function john(txt As String) As Long
Dim x
x = Split(Trim(txt), Chr(32))
john = Val(x(UBound(x)))
End Function
Which does work but I'd like to be able to apply this to the chapter number as well afterwards.
Private Sub FIND_LAST_NUMBER()
Dim A As String
Dim B As Integer
Dim C As String
Dim D As String
x = 3
Do While ActiveSheet.Cells(x, 4).Value <> ""
A = Range("D" & x).Value
A = Trim(A)
B = Len(A)
For Position = B To 1 Step -1
C = Mid(A, Position, 1)
'MsgBox C
If C <> " " Then
D = Right(A, B - Position)
Range("E" & x).Value = C
GoTo LastLine
'Exit Sub
End If
Next Position
LastLine:
x = x + 1
Loop
End Sub
but I'm trying to figure out how to get all of the number instead of only the last digit of the page number from the original cell
I am obviously not getting something here.
Any tips or tricks will be greatly appreciated
One, admittedly not very beautiful solution I can think of right away would be to use Replace to remove all non-numeric characters.
Dim str As String
str = Replace(str, " ", "") '<- to remove the random spaces
str = LCase(str) '<- making everything lower case
For i = 97 To 122
str = Replace(str, Chr(i), "")
Next i
Chr(i) with i from 97 to 122 will be every Character of the standard Alphabet.
This does not work if special Characters appear in the Chapter Name String. If the Chapter name contains numbers these will remain, but you could detect that case because UBound of the split array will be 1 greater than usual.
Also if you can quickly scan all the cells with your data for other unwanted Characters like - / or whatever might occur, you can also get rid of them with Replace
Performance of this solution might not be great but for a quick fix it might do..
I have a for loop, and inside it i have if statement.
In my Excel I have a list that contains each value one time. Once I found it i don't want the code to even check the conditional, i want it to skip this part of the if statement completely each time the loop is executed, is it possible?
Here is my code and list:
the first iteration of the loop will find that "c" is the value so it will do what inside it (xc = i)
I don't want the code to even check "ElseIf Cells(1, i) = "c" again, like the following image, is this possible?
code as text:
Sub test()
Dim i, xa, xb, xc As Integer
For i = 1 To 5
If Cells(i, 1) = "a" Then
xa = i
ElseIf Cells(i, 1) = "b" Then
xb = i
ElseIf Cells(i, 1) = "c" Then
xc = i
End If
Next i
End Sub
My initial interpretation of your need was "if the code hits 'c' again, just don't act".
To do so, you could modify the logic as follows:
ElseIf (xc = 0) And (Cells(i, 1) = "c") Then
This way, as soon as xc is set, the first boolean expression would be False, and the overall condition would not ever be met again. As mentioned by #TimWilliams, VBA would still evaluate the second boolean expression, unlike other languages that feature short-circuiting options. #Gene's answer describes a way around this. Typically, for better performance, you would evaluate the simple conditions first, before resorting to costly ones.
Additional notes
In VBA, you must give a type to each variable. In your Dim line, only xc is an Integer, while the other variables are Variants.
An unqualified Cells() call operates on the currently active worksheet, which might not be the expected one. Suggestion: qualify Cells() with the CodeName of your worksheet. The CodeName is what you see or specify under a worksheet's (Name) property as seen from the Visual Basic editor. For example, if (Name) is Sheet1, use Sheet1.Cells(). This will only work if the code resides in the same workbook as Sheet1. If the code is behind the worksheet itself, you can even use Me.Cells().
When dealing with cell values as your code does, VBA is (silently) being nice and understands that, among the numerous properties of the Range class, Value is what you are interested in. It is better practice, however, to explicitly state the target property, such as in Sheet1.Cells(i, j).Value.
EDIT
Knowing the values will be distinct and that there are about 60 of them, I suggest you simply use a Dictionary, as shown below, to get each value's row in one go, without a cascade of Ifs:
Option Explicit
Sub test()
Dim i As Integer
Dim dict As Object 'Scripting.Dictionary
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To 5
dict(Cells(i, 1).Value) = i
Next
Debug.Print dict("a") '4
Debug.Print dict("b") '2
Debug.Print dict("c") '1
'Etc.
End Sub
if i understood your question you can try this code:
Sub test()
Dim i, xa, xb, xc As Integer
Dim a, b, c As Boolean
a = False
b = False
c = False
For i = 1 To 5
If Cells(i, 1) = "a" And a <> True Then
xa = i
a = True
ElseIf Cells(i, 1) = "b" And b <> True Then
xb = i
b = True
ElseIf Cells(i, 1) = "c" And c <> True Then
xc = 1
c = True
End If
Next i
End Sub
Boolean variable is setted true for example only when the cells(i,1)="a" and after the next "a" value are skipped...
hope this helps
I just wanted to "mod" Ferdinando's code so it's a bit more "readable", I think. The main (the substantive) difference between this version and Ferdinando's or Excelosaurus' is that the cell is not even tested once the value is detected. Remember that the question was: I don't want the code to even check "ElseIf Cells(1, i) = "c" again... So, this version does exactly that.
Sub test()
Dim i As Integer, xa As Integer, xb As Integer, xc As Integer
Dim aFound As Boolean, bFound As Boolean, cFound As Boolean
Dim r As Range
For i = 1 To 5
Set r = Cells(i, 1)
If Not aFound Then
If r = "a" Then xa = i: aFound = True
ElseIf Not bFound Then
If r = "b" Then xb = i: bFound = True
ElseIf Not cFound Then
If r = "c" Then xc = i: cFound = True
End If
Next i
End Sub
I don't like the idea of 60 ElseIfs. Please examine the code below. In order to test it, create a worksheet called "TestSheet" and enter your A1:A5 to cells H2:H6.
Sub TestSpike()
' 06 Jan 2019
Dim Rng As Range
Dim Items As Variant
Dim Spike As String
Dim Tmp As String
Dim i As Integer
Dim R As Long
Items = Split("c|b|0|a|1", "|")
With Worksheets("TestSheet").Columns("H")
For R = 2 To 6
Tmp = CStr(.Cells(R).Value)
If InStr(1, Spike, Tmp, vbTextCompare) = 0 Then
Spike = Spike & "|" & Tmp
On Error Resume Next
i = Application.WorksheetFunction.Match(Tmp, Items, 0)
If Err Then
MsgBox Tmp & " wasn't found in Array"
Else
MsgBox "i = " & i & " = Item " & Tmp
End If
End If
Next R
End With
End Sub
The code has a "Spike". Each item is first checked against the Spike. If it is found there no further tests are carried out. Else, it is added to the Spike.
New items, after being added to the Spike, are checked against the Array "Items" which would hold your 60 elements, separated by Chr(124) thus, Split("c|b|0|a|1", "|"). I use the worksheet function MATCH to look for the item in the array. The result is an index number (or an error, if not found). You can use this index number in a Select Case statement to process each item distinct from others, basically the same way as you now process it when the If statement returns True.
One idea you may find useful with this kind of setup is to use the index from the Match function to return a value from another array. The other array might, for example, contain function names and you use Application.Run to call a different function for each item. This would run significantly faster than examining 60-odd Select Case statements.
I have the following table, Column(Dates), Rows(Id and Names). I am trying to add the values in each row only if there are seven consecutive values in them otherwise not. Never done any coding in vba so I am having hard time. Tried to write the formula and vba code but not knowing the syntax it's been very difficult.
Scan from C2 to AG2
if C2 is > 0 and C2=D2=E2=F2=G2=H2=I2 then
add C2+D2+E2+F2+H2+I2 store this value in AL2
Repeat the process until last filled row
Any insight into this would be greatly appreciated. I tried extensive search on this site and on google but couldn't find anything that is close to what I am doing, I was able to learn how to get the last filled column (in my case it only goes up to AH), last filled row (in my case it only goes up to 55), for loop. but not able to put this together.
Thx,
Archer
A VBA user-defined-function
EDIT: updated to ignore blanks
Function GetRun(rng, num)
Dim d, i As Long, c As Long, v, rv, tmp
d = rng.Value
v = Chr(0)
rv = ""
For c = 1 To UBound(d, 2) - 1
tmp = d(1, c)
'EDIT: skip blanks
If tmp <> v Or Len(tmp) = 0 Then
v = tmp
i = 1
Else
i = i + 1
If i = num Then
rv = v
Exit For
End If
End If
Next c
GetRun = rv
End Function
Use:
=GetRun(C2:AG2, 7)
I´m trying to unify the format of a large .xlsx file I received.
One of the problems I found, is that there are entries which "unique code" is "00UTract 32", "132Unit 359", "5555UT22"... and then I´ve found we´ve "00 UTract 32", "Unit 359, 132", and "22UT, 5555".
As you may suspect, there are duplicates, and I confirmed that was the case.
So, how should I do to add a space each time I find a letter next to a number, so I can start cleaning the mess easily?
Thanks!!!
Select the cells you wish to check/correct and run this macro:
Sub DataFixer()
Dim r As Range, DoIt As Boolean
Dim temp As String, CH As String, v As String
Dim i As Long, L As Long
For Each r In Selection
temp = ""
DoIt = False
v = r.Value
L = Len(v)
CH = Mid(v, 1, 1)
temp = CH
For i = 2 To L
CH = Mid(v, i, 1)
If IsNumeric(Right(temp, 1)) And CH Like "[a-zA-Z]" Then
DoIt = True
temp = temp & " "
End If
temp = temp & CH
Next i
If DoIt Then r.Value = temp
Next r
End Sub
The macro checks each select cell for occurrences of:
{number}{letter}
and replaces them with:
{number} {letter}
I'd probably do this the other way around assuming that the only difference in IDs are the spaces.
Simply remove all spaces from that column, and you will get the same values, without having to deal with checking each character in a string.
This can be done via CTRL+H and no need to introduce VB in it.
When I compare the value of a cell that contains ? to a variable, it always returns true. Is there any way I can prevent this? Here is my current code:
'Option Explicit
Dim hws As Worksheet
Set hws = ActiveSheet
Dim rng As Range, rng2 As Range
Dim letters(2, 2)
alpha = Range("CipherTable").Value
For x = 1 To 7
For y = 1 To 7
If alpha(x, y) = rng.Cells(i, j + 1).Value Then
letters(2, 1) = x
letters(2, 2) = y
End If
Next y
Next x
alpha, by the way, looks like this:
A B C D E F G
H I J K L M N
O P Q R S T U
V W X Y Z 1 2
3 4 5 6 7 8 9
0 ; : ' " . ,
( ) _ - + ? !
This always returns A, which is in alpha(1,1). Come to think of it, since they each go to seven, I don't know why it don't come back with !. How can I get around this and make it return true only when it actually matches?
As far as I understand you want to create a substitution algorithm. If there is no specific reason to use a two dimensional cipher table I would rather use a one dimensional approach like the following:
Function Cipher(Argument As String) As String
Dim Model As String
Dim Subst As String
Dim Idx As Integer
Dim MyPos As Integer
Cipher = ""
' note double quotation mark within string
Model = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890;:'"".,()_-+?!"
Subst = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890;:'"".,()_-+?!"
For Idx = 1 To Len(Argument)
' get position from Model
MyPos = InStr(1, Model, UCase(Mid(Argument, Idx, 1)))
' return character from substitution pattern
If MyPos <> 0 Then Cipher = Cipher & Mid(Subst, MyPos, 1)
Next Idx
End Function
calling this function with
Sub Test()
Debug.Print Cipher("The quick brown (?) fox 123 +-")
End Sub
results in THEQUICKBROWN(?)FOX123+- (because we don't allow blanks in Model or Subst)
Now change Subst to
Subst = "!?+-_)(,.""':;0987654321ZYXWVUTSRQPONMLKJIHGFEDCBA"
result is 4,_73.+'?6910GBF)9ZWVUCD
if you feed the above into the cipher function, you end up again with THEQUICKBROWN(?)FOX123+- as you would expect from a symetrical substitution.
I tried the following, and got the expected result (it was able to find the question mark):
(1) Created CipherTable range in worksheet, as above;
(2) Created a function QM similar to code above;
(3) Entered a formula in the style of =QM(cell-ref).
It worked fine. Function QM:
Public Function QM(theChar)
Dim CipherTable
Dim x As Integer
Dim y As Integer
CipherTable = Range("CipherTable").Value
For x = 1 To 7
For y = 1 To 7
If CipherTable(x, y) = theChar Then
QM = "X" & x & "Y" & y
Exit Function
End If
Next y
Next x
QM = ""
End Function
====
I also tried something more direct, and got the response expected:
Public Sub QM2()
Dim questMark As Range
Dim someChar As String
Set questMark = Range("CipherTable").Cells(7, 6)
someChar = "A"
Debug.Print questMark = someChar
End Sub