VBA macro copies wrong data to cell - excel

This is what I am trying to do:
If J contains the word Defendant
And
If F contains the word Foreclosure
Then
If G contains " V ESTATE OF "
Then keep everything to the right of "OF"
Else If G contains " VS "
Then keep everything to the right of " VS "
Else If G contains " V " (notice the spaces before and after V)
Then keep everything to the right of " V "
If K contains " " (two consecutive spaces)
Then Keep it
Or
If K contains "UNKNOWN SPOUSE OF"
Then remove the very last character of cell, which will be a comma
And if the cell begins with an underscore
Then remove it
Then Keep it
Assign the result of G to the corresponding N cell
Assign the result of K to the corresponding O cell
This is what I did:
Sub Inspect()
Dim RENums As Object
Dim RENums2 As Object
Dim LValue As String
Dim LValue2 As String
Set RENums = CreateObject("VBScript.RegExp")
Set RENums2 = CreateObject("VBScript.RegExp")
RENums.Pattern = "DEFENDANT"
RENums2.Pattern = "FORECLOSURE"
Dim lngLastRow As Long
lngLastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Dim i
For i = 1 To lngLastRow
If RENums2.test(Range("F" & i).Value) Then
If RENums.test(Range("J" & i).Value) Then
pos = InStr(Range("G" & i), " V ")
pos2 = InStr(Range("G" & i), " VS ")
pos3 = InStr(Range("G" & i), " V ESTATE OF ")
dbspace = InStr(Range("K" & i), " ")
If pos3 <> 0 Then
LValue2 = Right(Range("G" & i), Len(Range("G" & i)) - pos * 2)
ElseIf pos <> 0 Then
LValue2 = Right(Range("G" & i), Len(Range("G" & i)) - pos - 2)
ElseIf pos2 <> 0 Then
LValue2 = Right(Range("G" & i), Len(Range("G" & i)) - pos - 2)
End If
If dbspace <> 0 Then
LValue = Range("K" & i)
End If
schr = Right(LValue, 1)
If schr = "_" Then
With WorksheetFunction
Range("N" & i).Value = Trim(.Substitute(LValue, "_", ""))
End With
Else
Range("N" & i).Value = Trim(LValue)
End If
Range("O" & i).Value = Trim(LValue2)
End If
End If
Next i
End Sub
With the above macro, the correct value is never pasted into N in some cases. Rather a value from another cell in K is pasted to the wrong cell in N.
I attached an example of excel spreadsheet on the below link to which I never received a response:
http://www.excelforum.com/excel-programming/775695-wrong-data-copied-into-new-cell-from-macro.html
Thanks for response.

Your LValue and LValue2 variables are being populated conditionally (ie, not each time through the loop), but your final block is executed EVERY TIME, so it stands to reason that some times through the loop, you are using an old value of LValue or LValue2 (or both).
You need to clear them out at the beginning of the loop, or else have an ELSE clause in both your LValue and LValue2 IF blocks that takes care of that scenario.
Edit based on your comment: I prefer using MID() to RIGHT() in this scenario, makes it much easier to get the math right, since we're counting from the left (which is the value that InStr() returns):
cellText = Range("K" & i).Value
LValue = Mid(cellText, Unknown + 18, 100)
A few additional notes:
You use it so many times, put the tested value into a variable like I did above. It might even be marginally faster that way instead of going back to the worksheet each time.
I prefer to use Cells(11, i).Value to Range("K" & i).Value. Works the same, but much easier to use with variable row or column numbers.
It usually works the way you've done it, but make sure to use the correct property of the range object (Range().Value or Range().Formula or whatever) instead of just relying on the "default property" to always be correct.

When checking for the underscore, you are testing if the last character is an underscore. Your question states that you want to test if the value begins with an underscore.
schr = Right(LValue, 1)
If schr = "_" Then
Try
schr = Left(LValue, 1)
If schr = "_" Then

Related

VBA vlookup iferror formula error '1004' while inserting a formula to cell

I have a short code about inserting a formula to the cell instead of obtaining values but when I tried to use that with VLOOKUP and/or IFERROR, I get error 1004. I did it with SUB, SUBTOTAL before but couldn't achieved with these functions. If you may help, that would be amazing.
GerçekStok = 0
Set StokBook = ActiveWorkbook
Set BticinoBook = Workbooks("BTICINO.xlsm")
NoS = BticinoBook.Sheets.Count
For k = 1 To NoS
If BticinoBook.Sheets(k).Name = "DRAFT" Then
DNumber = k
Exit For
End If
Next k
TotalRow = BticinoBook.Sheets(DNumber).Cells(Rows.Count, 4).End(xlUp).Row
If GerçekStok = 0 Then
For i = 2 To TotalRow
BticinoBook.Sheets(DNumber).Cells(i, 2) = "=IFERROR(VLOOKUP(D" & i & ";'[" & StokBook.Name & "]Sheet2'!$A:$E;3;FALSE);" & Chr(34) & Chr(48) & Chr(34) & Chr(41)
Next i
Else
For i = 2 TotalRow
BticinoBook.Sheets(DNumber).Cells(i, 2) = "=IFERROR(VLOOKUP(D" & i & ";'[" & StokBook.Name & "]Sheet2'!$A:$E;4;FALSE);" & Chr(34) & Chr(48) & Chr(34) & Chr(41)
Next i
End If
You need to use .Formula to enter a formula into a cell.
Range("B10").Formula = "=SUM(B4:B9)"
If your string contains another string with double quotes, then you need to type the double quote twice, like this:
... whatever... ;FALSE);""0"")"
Using Chr() instead of the typed characters doesn't really fix the issue.
BticinoBook.Sheets(DNumber).Cells(i, 2).formula = "=IFERROR(VLOOKUP(D" & i & ";'[" & StokBook.Name & "]Sheet2'!$A:$E;3;FALSE);""0"")"
Of course, there is no reason to put a zero inside of double quotes, so you could simply use
BticinoBook.Sheets(DNumber).Cells(i, 2).formula = "=IFERROR(VLOOKUP(D" & i & ";'[" & StokBook.Name & "]Sheet2'!$A:$E;3;FALSE);0)"

Using Sumproduct to count nth digit in column

I have a formula that works in Excel, I am trying to count the occurrences of J as the 2nd digit
=SUMPRODUCT(--(MID(J2:J2000,2,1)="J"))
The problem is I can't seem to get this to work in VBA...
Dim rng As Range
Set rng = temps.Range("J2:J2000")
n = Evaluate(WorksheetFunction.SumProduct(--(Mid(rng.Address, 2, 1) = "J")))
Any ideas?
I forgot I needed to pass a string to evaluate. The following worked:
n = temps.Evaluate("SumProduct(--(Mid(" & rng.Address & ", 2, 1) = " & Chr(34) & "J" & Chr(34) & "))")

Extracting the first digit from an alpha-numeric string

Is it possible to use VBA to catch and use the first number in a text string and if there is no number then just use 1?
The code I'm currently using is looking at column AC and finding a specific text then using the first two letters of that text and the right most number and replacing the corresponding row in column N.
What I'm attempting to do now is account for when there is no number in the text (should =1), or there is but it's in the mid but the location moves (thus a mid statement wouldn't work). If this is possible Any suggestions or push in the right direction would be appreciated.
Dim wsl As Worksheet
Dim LR As Long, i As Long
mydate = Format(Date, "YYMMDD")
Set wsl = LagoDLFile.Sheets("cid_SeventhAvenue_" & mydate & "")
LR = wsl.Range("AC" & wsl.Rows.Count).End(xlUp).Row
For i = 2 To LR
If wsl.Range("AC" & i) Like "*EOC*" Then
wsl.Range("N" & i) = "EOC"
ElseIf wsl.Range("N" & i) Like "700" Then
wsl.Range("N" & i) = "CHK"
ElseIf wsl.Range("AC" & i) Like "*CTOB*" Then
wsl.Range("N" & i) = "COF"
ElseIf wsl.Range("AC" & i) Like "EXOBC*" Then
wsl.Range("N" & i) = "WR" & Right(wsl.Range("AC" & i), 1)
ElseIf Left(wsl.Range("AC" & i), 3) = "OBC" Then
wsl.Range("N" & i) = "OB" & Right(wsl.Range("AC" & i), 1)
ElseIf Left(wsl.Range("AC" & i), 3) = "IFC" Then
wsl.Range("N" & i) = "IF" & Right(wsl.Range("AC" & i), 1)
ElseIf Left(wsl.Range("AC" & i), 3) = "IBC" Then
wsl.Range("N" & i) = "IB" & Right(wsl.Range("AC" & i), 1)
End If
Next i
End Sub
Here is a function that uses regular expressions to do what you need. It uses this regex:
^\D*(\d)
Breaking down the pattern
^ Start of string
\D* Any character that is not a digit (capital D), with a * quantifier that means 0 or more times
(...) Capturing group - it will capture the text that you want to keep and return it as a submatch
\d any numerical value (0-9).
Note: If you want it to capture more than the first digit (such as string123 - you want to return 123, you can change (\d) in the above regex to (\d+). The + is a quantifier that means one or more of \d.
See this regex work at Regex101. The green highlighted portion is what would be returned from the below function.
Creating the function / UDF
Public Function getFirstDigit(testString As String) As String ' or As long
With CreateObject("VBScript.RegExp")
.Pattern = "^\D*(\d)"
.Global = False
If .test(testString) Then
getFirstDigit = .Execute(testString)(0).SubMatches(0)
Else
getFirstDigit = "1"
End If
End With
End Function
You can use this function within both VBA and as a worksheet function.
Using in VBA:
Msgbox getFirstDigit("Test String 123")
Using in the worksheet
=getFirstDigit($A$1)
Variant without RegExp
Public Function firstIntInString(testStr As String) As Integer
Dim x%
For x = 1 To Len(testStr)
If Mid(testStr, x, 1) Like "#" Then
firstIntInString = Mid(testStr, x, 1)
Exit For
Else
firstIntInString = 1 'in case when string doesn't contains digits
End If
Next x
End Function

Check for duplicates sum

I want to check for duplicates in a column and my code is able to do so. But when it finds a duplicate in column L i want it to add "+1" to the integer in column c. So if "L5 and L6" are the same, I want "C5" to be "C5+1". But I have not been able to figure out how to do so.
Sub check_duplicates()
Dim x As Long
Dim LastRow As Long
LastRow = Range("L65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("L2:L" & x), Range("L" & x).Value) > 1 Then
Range("C" & x).Formula = "=LEFT(x) + 1"
End If
Next x
End Sub
That should solve your problem:
Sub check_duplicates()
Dim x As Long
Dim LastRow As Long
LastRow = Range("L65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("L2:L" & x), Range("L" & x).Value) > 1 Then
Range("C" & x) = Left(Range("C" & x), 1) + 1 & Mid(Range("C" & x), 2)
End If
Next x
End Sub
Replace Range("C" & x).Formula = "=LEFT(x) + 1" with something like Range("C" & x)=Range("C" & x) + 1. Making the formula in C5=C5+1 would be circular and would cause an error. Alternatively, set a variable equal to range C5, add 1 to it, then set range C5 to this variable. I'm assuming column C is a set of integers here and not formulas.
You can increment the value by wrapping the Left function (VBA version) around the cell value to get the value to increment by one and then use the space to extract the value to the right `"P" in your example, then bring them back together.
See the code below. It will work for instances where the number increments above single digits and it also assumes there will always be a space after the number and before the text.
Sub check_duplicates()
Dim x As Long
Dim LastRow As Long
LastRow = Range("L65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("L2:L" & x), Range("L" & x).Value) > 1 Then
Dim y As Long, x As String
'increment left number by 1
y = Left(Range("C" & x).Value, InStr(1, Range("C" & x).Value, " ") - 1) + 1
'extract text after space
x = Mid(Range("C" & x).Value, InStr(1, Range("C" & x).Value, " "))
Range("C" & x).Value = y & x ' bring together and set the cell value to new incremented value
End If
Next x
End Sub

Crazy issue with string formatting

I am running into an issue that is driving me crazy. I have two FOR loops in my macro that each have a counter to keep track of how many times a certain process was performed. The counters work great and at the end of the loop contain the correct numbers. The next thing I have to do is to format the counts into a five digit number with leading zeros. I have tried this using two different approaches (see below).
cCount = String(5 - Len(cTemp), "0") & cTemp
mCount = String(5 - Len(mTemp), "0") & mTemp
or
cCount = Format(cTemp, "00000")
mCount = Format(mTemp, "00000")
The problem is with the second counter. As I step through it, the first format formula works, but the second line does not, regardless of which version above that I use. Now here is the thing, if, while I am still in the macro, I go and change the name of mCount to anything else, for example mCnt, and then move the macro step back up to reprocess that line, it will correctly format the variable. But it isn't the name, because if I then run the macro again using mCnt, it will do the same thing. I can change it back to mCount and it will work.
All variables are dimmed as Integers. An example of what I am looking for would be if mTemp is 15, then mCount would be 00015. However, mCount is just coming back as 15. cCount is working fine.
The fact that everything is correct and that I can make it work if I pause the macro, change the variable name, and reprocess the line, has got me completely at a loss as to what the issue is.
Sub MakePay()
Dim strFileToOpen As String
Dim payDate, payTab, payCheckTemp, payCheck, payAccTemp As String
Dim payAcc, payAmount, payTotalC, payTotalM As String
Dim savePath As String
Dim payFileNameCLP, payFileNameMF As String
Dim payString1, payString2, payString3, payString4, payString5, payString6 As String
Dim payString7, payString8, payString9 As String
Dim rCnt, i, j, cTemp, cCount, mTemp, mCount As Integer
Dim payTotalMTemp, payAmountTemp, payTotalCTemp As Double
' Set date
payDate = Format(Now(), "yyyymmddhhmmss")
' Ask for check number and format to field length
payCheckTemp = InputBox("Please enter the check number.")
payCheck = payCheckTemp & String(15 - Len(payCheckTemp), " ")
' Create file names and open text files for writing
payFileNameCLP = "CLP_" & payDate & "_01.txt"
payFileNameMF = "MDF_" & payDate & "_01.txt"
savePath = Environ("USERPROFILE") & "\Desktop\"
Open savePath & payFileNameCLP For Output As #1
Open savePath & payFileNameMF For Output As #2
' Build header rows and print them
payString1 = "100"
payString2 = "200 C"
Print #1, payString1
Print #1, payString2
Print #2, payString1
Print #2, payString2
' reset counters for number of claims and total dollar amounts in files
cTemp = 0
mTemp = 0
payTotalCTemp = 0
payTotalMTemp = 0
For i = 1 To Sheets.Count
' Process the Clearpoint tab
If Left(Sheets(i).Name, 3) = "CLE" Then
Sheets(i).Activate
rCnt = Cells(Rows.Count, 1).End(xlUp).Row
For j = 3 To (rCnt - 1)
' Read accession # and format it for field length
payAccTemp = Cells(j, 3).Value
payAcc = payAccTemp & String(17 - Len(payAccTemp), " ")
' Read payment amount, if $0, skip
payAmountTemp = Format(Cells(j, 5).Value2, "#,###.00")
If payAmountTemp = "" Then
GoTo SkipCDL
End If
' Add payment to total Clearpoint payments
payTotalCTemp = payTotalCTemp + payAmountTemp
' Format payment by deleting decimal and then format to field length
payAmount = Format(payAmountTemp * 100, "0000000;-000000")
' Build payment strings and print them
payString3 = "400" & String(10, " ") & payAcc & payCheck
payString4 = "450" & String(10, " ") & payAcc & String(150, " ") & payAmount
payString5 = "500" & String(10, " ") & payAcc & String(73, " ") & payAmount
Print #1, payString3
Print #1, payString4
Print #1, payString5
' Increase Clearpoint patient count
cTemp = cTemp + 1
SkipCDL:
Next j
' Process Medfusion tab
ElseIf Left(Sheets(i).Name, 3) = "MED" Then
Sheets(i).Activate
rCnt = Cells(Rows.Count, 1).End(xlUp).Row
For j = 3 To (rCnt - 1)
' Read accession # and format it for field length
payAccTemp = Cells(j, 3).Value
payAcc = payAccTemp & String(17 - Len(payAccTemp), " ")
' Read payment amount, if $0, skip
payAmountTemp = Format(Cells(j, 5).Value2, "#,###.00")
If payAmountTemp = "" Then
GoTo SkipMDF
End If
' Add payment to total Medfusion payments
payTotalMTemp = payTotalMTemp + payAmountTemp
' Format payment by deleting decimal and then format to field length
payAmount = Format(payAmountTemp * 100, "0000000;-000000")
' Build payment strings and print them
payString3 = "400" & String(10, " ") & payAcc & payCheck
payString4 = "450" & String(10, " ") & payAcc & String(150, " ") & payAmount
payString5 = "500" & String(10, " ") & payAcc & String(73, " ") & payAmount
Print #2, payString3
Print #2, payString4
Print #2, payString5
' Increase Medfusion count
mTemp = mTemp + 1
SkipMDF:
Next j
End If
Next i
' Format patient counter and total payment to field length
cCount = Format(cTemp, "00000")
mCount = Format(mTemp, "00000")
payTotalC = Format(payTotalCTemp * 100, "000000000;-00000000")
payTotalM = Format(payTotalMTemp * 100, "000000000;-00000000")
' Build footer strings and print them
payString6 = "800" & String(26, " ") & "9999" & cCount & String(131, " ") & payTotalC
payString7 = "800" & String(26, " ") & "9999" & mCount & String(131, " ") & payTotalM
payString8 = "900" & String(57, " ") & "099990" & cCount & String(154, " ") & String(2, "0") & payTotalC
payString9 = "900" & String(57, " ") & "099990" & mCount & String(154, " ") & String(2, "0") & payTotalM
Print #1, payString6
Print #2, payString7
Print #1, payString8
Print #2, payString9
' Close all files
Application.DisplayAlerts = False
Close #1
Close #2
Application.DisplayAlerts = True
End Sub
The issue is with how the variables are declared.
In VBA/classic vb, all declarations should be on their own line OR have the correct data type specified, otherwise you risk accidentally creating a Variant data type, which can masquerade as any other data type, which the VB engine has rules for determining the type.
See https://msdn.microsoft.com/en-us/library/56ht941f(v=vs.90).aspx
Also, whenever coding in VBA make sure Option Explicit is declared at the top of any new code module. It will save you loads of pain in the future.
Also, you are trying to push String formatting into an Integer, which cannot happen.
So...
Option Explicit
.....
'Dim i, j as Integer 'BAD i is a variant, j is an integer
Dim i As Integer
Dim j As Integer 'GOOD both are Integers
'OR
Dim x As Integer, y as Integer 'I believe this will work too
dim displayI as String
i = 23
displayI = Format(i, "00000")
In your code why not just format inline?
payString6 = "800" & String(26, " ") & "9999" & Format(cCount,"00000") & String(131, " ") & payTotalC

Resources