VBA vlookup for value at string and back
These are columns A, B and C in the excel sheet.
If the average account number in column A is> 40,000 and <60,000, then the actual amount must be multiplied by -1. What is VB Code?
Account Number Account Description Actual Amount
10-40100-400 Contributions - Support ($12,843.63)
10-53450-400 Rental Income ($9,584.60)
10-53500-400 Housing Income ($67,933.38)
10-54900-400 Miscellanous Revenue ($2,615.56)
10-72100-400 Salary and Wages $43,378.11
10-72100-420 Salary and Wages $607.91
10-72400-400 Health Insurance $14,843.94
10-72440-400 Life Insurance $286.62
10-72500-400 FICA Expense $3,283.73
10-72500-420 FICA Expense $46.50
10-75400-400 Professional Services $9,392.28
10-81100-400 Office Supplies $3,754.16
10-81300-400 Telephone $540.00
10-82110-400 Furnishings and Equipment $6,186.20
10-82140-400 Maintenance & Repair-Equi $4,658.21
10-82160-400 Maintenance & Repair-Buil $13,576.61
10-82200-400 Utilities $35,467.33
10-82600-400 Vehicle Expenses $196.18
10-83100-400 Meals and Entertainment $10.83
10-83140-400 Travel $34.84
10-85240-400 Prop/Casualty Insurance $22,535.60
10-85260-400 Auto Insurance $691.47
10-85300-400 Dues and Subscriptions $145.00
10-85980-400 Miscellaneous Expense ($45.00)
10-86500-400 Permits and Licenses $1,010.00
10-99150-400 Ministry Grant Transfers $32,249.97
10-99200-400 Ministry Transfers ($8,992.44)
20-72100-400 Salary and Wages $0.00
Totals for 71500: $0.00
Grand Totals: $0.00
I tried to copy column A to column D and then trim it to a number.
Then use an if statement to do the opposite.
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A15:A" & lastrow).Copy Range("D15")
Dim rng As Range
Dim rngsear As Range
Set rng = Range("D15:D" & lastrow)
For Each rng In Selection
rng = Mid(rng, 4, 5)
Next rng
With ActiveSheet
lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
Set rng = .Range("D15:D" & lastrow)
Set rngsear = .Range("C15:C" & lastrow)
rngsear.Value = .Evaluate("IF((" & rng.Address & " >= 40000)*(" & rng.Address & " < 60000)," & rngsear.Address & " * -1," & rngsear.Address & ")")
End With
But it conflicts with the previous code I used to get 3 columns.
Dim sSheetName As String
Dim sDataRange As String
sSheetName = ActiveSheet.Name
sDataRange = Selection.Address
Range("C9:F9").Select
Selection.Cut Destination:=Range("D9:G9")
Range("C:C,D:D,F:F,G:G").Select
Range("G1").Activate
Selection.Delete Shift:=xlToLeft
Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A15:C" & lastrow).Sort key1:=Range("A15:A" & lastrow), _
order1:=xlAscending, Header:=xlNo
What's the best way to do this?
source to share
Take a look below and see if that helps.
Sub Check()
Dim str_extract As String
Dim lastrow As Integer
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
For x = 1 To lastrow
If (Right(Left(Cells(x, 1).Value, 8), 5) >= 40000 And Right(Left(Cells(x, 1).Value, 8), 5) < 60000) _
Then Cells(x, 3).Value = Cells(x, 3).Value * -1
Next x
MsgBox "Done"
End Sub
source to share
Use Mid
to get the 5-digit account number from the value in column A and use Val
to convert it to a number. Then you can check> = 40,000 and <= 60,000 and multiply the balance by -1 if needed. Once you know the balance, you can simply set the value of column D.
Option Explicit
Sub ConvertBalance()
Dim ws As Worksheet
Dim lngLastRow As Long
Dim lngRow As Long
Dim lngAccountNumber As Long
Dim lngBalance As Long
Set ws = ThisWorkbook.Worksheets("Sheet1") '<-- change to your worksheet
lngLastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
For lngRow = 2 To lngLastRow '<-- change start row if you need to
lngAccountNumber = Val(Mid(ws.Cells(lngRow, 1).Value, 4, 5))
lngBalance = ws.Cells(lngRow, 3).Value
If lngAccountNumber >= 40000 And lngAccountNumber <= 60000 Then
lngBalance = lngBalance * -1
End If
ws.Cells(lngRow, 4) = lngBalance
Next lngRow
End Sub
If you just want to use the formula on column D inserted in VBA, you can use this formula:
=C2*IF(AND(VALUE(MID(A2,4,5))>=40000,VALUE(MID(A2,4,5))<=60000),-1,1)
And in the code it is:
Option Explicit
Sub ConvertBalance2()
Dim ws As Worksheet
Dim lngLastRow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1") '<-- change to your worksheet
lngLastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
With ws.Range("D2:D" & lngLastRow)
.Formula = "=C2*IF(AND(VALUE(MID(A2,4,5))>=40000,VALUE(MID(A2,4,5))<=60000),-1,1)"
End With
End Sub
source to share