score:0
You have to forecast and handle all possible conditions. Use this code please:
Sub Test()
Application.ScreenUpdating = False
Dim row As Integer
Dim Lastrow As Long
'I've assumed that you are working on sheet1
Lastrow = Sheets(1).Cells(Rows.Count, "D").End(xlUp).row
If Lastrow > 1 Then
For row = 2 To Lastrow
If Sheets(1).Cells(row, 1).Value = "Bol" Then
Sheets(1).Cells(row, 4).Value = Sheets(1).Cells(row, 4).Value * 1.19
End If
If Sheets(1).Cells(row, 1).Value = "Amazon" Then
Sheets(1).Cells(row, 4).Value = Sheets(1).Cells(row, 4).Value * 1.2
End If
Next
Else
MsgBox ("There is no data at column D")
End If
Application.ScreenUpdating = True
End Sub
score:0
There are quite a few ways to go about what you're trying to do. For what it's worth, this is how I would go about it. You had a few additional variables you didn't need, and your 'row' variable wasn't assigned a value at all.
Sub test2()
Dim lastRow As Long, _
i As Long
Application.ScreenUpdating = False
With Sheet1
lastRow = .Cells(Rows.Count, "D").End(xlUp).row
For i = 2 To lastRow
If .Cells(i, 1).Value = "Bol" Then
.Cells(i, 4).Value = .Cells(i, 4).Value * 1.19
End If
If .Cells(i, 1).Value = "Amazon" Then
.Cells(i, 4).Value = .Cells(i, 4).Value * 1.2
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
I kept is relatively simple, so hopefully you can follow what's going on. If you have a lot of "If" statements, it may be cleaner to use VBAs "Select Case".
Also the text strings as you have them set up are case sensitive. "Bol" does not equal "bol" maybe that doesn't matter, but something to be aware of. If the string you pass it is "amazon" it will not pass the 'If' test.
Another assumption I made was that your data is on Sheet1. You should get in the habit of fully qualifying your ranges, it will make your life a lot easier as your code gets more complicated.
Last bit, I'm assuming the values in column D are all numbers. If there is text in there, you may run in to problems multiplying it.
Good luck!
score:0
You can simplify your code, and make it easier to read, by looping trough column A
instead of column D
and using the If/ElseIf
statement to test each cell for either of the two conditions. By setting your range and defining c
as a range variable for each cell in the range, you only have to loop through each cell and test for the two conditions. If
the cell contains Bol
use the Offset
property to multiple the current value in column D
by 1.19
; ElseIf
the cell contains Amazon
use the Offset
property to multiple the current value in column D
by 1.2
. Comments provide in the code.
Application.ScreenUpdating = False
'use the With statement to define your workbook and sheet, change as needed
'Note: "ThisWorkbook" identifies the workbook which contains this code
With ThisWorkbook.Sheets("Sheet1")
'Define the range you want to loop through, using the column you want to test
Dim rng As Range: Set rng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
'Define the variable for each cell-range
Dim c As Range
'loop through each "c" in the range and if one of the conditions are met
For Each c In rng
If c = "Bol" Then
'then use the "Offset property" to modify the value in column D
c.Offset(, 3) = c.Offset(, 3).Value * 1.19
ElseIf c = "Amazon" Then
c.Offset(, 3) = c.Offset(, 3).Value * 1.2
End If
Next c
End With
Application.ScreenUpdating = True
score:0
In-Place Modification
All the solutions have one common issue: you can use them only once. If you need to change the values after adding new records (rows) you should consider adding another column with the initial values so the code could be written to identify what has already been changed and what not. But that's for another question.
Your Sub Solution
You actually had only one serious mistake in two-three places.
Instead of row
in the If
statements you should have used c.Row
and you could have removed Dim row As Integer
:
Sub Test_Almost_Fixed()
Application.ScreenUpdating = False
Dim startrow As Integer
Dim c As Range
Dim Lastrow As Long
Application.ScreenUpdating = False
Lastrow = Cells(Rows.Count, "D").End(xlUp).row
For Each c In Range("D2:D" & Lastrow)
If Cells(c.Row, 1) = "Bol" Then
c.Value = c.Value * 1.19
End If
If Cells(c.Row, 1) = "Amazon" Then
c.Value = c.Value * 1.2
End If
Next
Application.ScreenUpdating = True
End Sub
Additionally after getting rid of the extra Application.ScreenUpdating = False
and the Dim startrow As Integer
and some further cosmetics, you could have had something like this:
Sub Test_Fixed()
Dim c As Range
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "D").End(xlUp).row
Application.ScreenUpdating = False
For Each c In Range("D2:D" & Lastrow)
If Cells(c.Row, 1) = "Bol" Then
c.Value = c.Value * 1.19
End If
If Cells(c.Row, 1) = "Amazon" Then
c.Value = c.Value * 1.2
End If
Next
Application.ScreenUpdating = True
End Sub
A More Complex Sub Solution
Use the following for the ActiveSheet
in a standard module (e.g. Module1
). For a particular sheet you can place it in a sheet module (e.g. Sheet1
) or create a button on the sheet.
Tip: When you have such a simple (short, fast) code and especially when you're using a Button
to run it (in a 'one-time operation code'), it is good practice to use a MsgBox
at the end of the code to actually know that the code has run and to prevent accidentally pressing the Button
more than once.
Option Explicit
Sub Test()
Const Proc As String = "Test"
On Error GoTo cleanError
' Define Constants.
Const FirstRow As Long = 2
Const SourceColumn As Variant = 1 ' e.g. 1 or "A"
Const TargetColumn As Variant = 4 ' e.g. 4 or "D"
Dim Criteria As Variant ' Add more values.
Criteria = Array("Bol", "Amazon")
Dim Multiplier As Variant ' Add more values.
Multiplier = Array(1.19, 1.2)
' Check if Criteria and Multiplier Arrays have the same number
' of elements (columns).
Dim ubCM As Long: ubCM = UBound(Criteria)
If UBound(Multiplier) <> ubCM Then Exit Sub
' Write Source and Target Ranges to Source and Target Arrays.
Dim rng As Range
' Define Last Non-Empty Cell.
Set rng = Columns(TargetColumn).Find("*", , xlValues, , , xlPrevious)
' Check if Target Column is empty.
If rng Is Nothing Then Exit Sub
' Check if the row of Last Non-Empty Cell is above FirstRow.
If rng.Row < FirstRow Then Exit Sub
Dim Target As Variant
' Write Target Range to Target Array.
Target = Range(Cells(FirstRow, TargetColumn), rng).Value
Set rng = Nothing
Dim ubST As Long: ubST = UBound(Target)
Dim Source As Variant
' Write Source Range to Source Array.
Source = Cells(FirstRow, SourceColumn).Resize(ubST).Value
' Modify Target Array.
Dim i As Long, j As Long
' Loop through elements (rows) of Source and Target Arrays.
For i = 1 To ubST
' Loop through elements (columns) of Criteria and Multiplier Arrays.
For j = 0 To ubCM
' Check if the value in current element (row) of Source Array
' matches the value of current element (column) in Criteria Array.
If Source(i, 1) = Criteria(j) Then
' Modify value in current element (row) of Target Array
' by multiplying it with the value of current element (column)
' of Multiplier Array.
Target(i, 1) = Target(i, 1) * Multiplier(j)
' Since a match is found, there is no need to loop anymore.
Exit For
End If
Next j
Next i
Erase Source
' Write values of Target Array to Target Range.
Cells(FirstRow, TargetColumn).Resize(ubST).Value = Target
Erase Target
' Inform user.
MsgBox "Data copied.", vbInformation, "Success"
Exit Sub
cleanError:
MsgBox "An unexpected error occurred in '" & Proc & "'." & vbCr _
& "Run-time error '" & Err.Number & "':" & vbCr & Err.Description _
, vbCritical, Proc & " Error"
End Sub
An Event Solution
To make it automatically change the values in column D
for each change of a value in column A
you can place the following code into the sheet module (e.g. Sheet1
):
Option Explicit
Private Const SOURCE_COLUMN As Variant = 1 ' e.g. 1 or "A"
Private Const TARGET_COLUMN As Variant = 4 ' e.g. 4 or "D"
Private Sub sdfWorksheet_Change(ByVal Target As Range)
Const Proc As String = "Worksheet_Change"
On Error GoTo cleanError
If Intersect(Columns(SOURCE_COLUMN), Target) Is Nothing Then Exit Sub
Const FirstRow As Long = 2
Dim rng As Range
Set rng = Columns(TARGET_COLUMN).Find("*", , xlValues, , , xlPrevious)
If rng Is Nothing Then Exit Sub
If rng.Row < FirstRow Then Exit Sub
Set rng = Cells(FirstRow, SOURCE_COLUMN).Resize(rng.row - FirstRow + 1)
If Intersect(rng, Target) Is Nothing Then Exit Sub
Dim cel As Range
Application.Calculation = xlCalculationManual ' -4135
For Each cel In Target.Cells
TestChange cel
Next cel
CleanExit:
Application.Calculation = xlCalculationAutomatic ' -4105
Exit Sub
cleanError:
MsgBox "An unexpected error occurred in '" & Proc & "'." & vbCr _
& "Run-time error '" & Err.Number & "':" & vbCr & Err.Description _
, vbCritical, Proc & " Error"
On Error GoTo 0
Resume CleanExit
End Sub
Private Sub TestChange(SourceCell As Range)
Const Proc As String = "TestChange"
On Error GoTo cleanError
Dim Criteria As Variant
Criteria = Array("Bol", "Amazon")
Dim Multiplier As Variant
Multiplier = Array(1.19, 1.2)
Dim ubCM As Long: ubCM = UBound(Criteria)
If UBound(Multiplier) <> ubCM Then Exit Sub
Application.ScreenUpdating = False
Dim TargetCell As Range, j As Long
For j = 0 To ubCM
If SourceCell.Value = Criteria(j) Then
Set TargetCell = Cells(SourceCell.row, TARGET_COLUMN)
TargetCell.Value = TargetCell.Value * Multiplier(j)
Exit For
End If
Next j
CleanExit:
Application.ScreenUpdating = True
Exit Sub
cleanError:
MsgBox "An unexpected error occurred in '" & Proc & "'." & vbCr _
& "Run-time error '" & Err.Number & "':" & vbCr & Err.Description _
, vbCritical, Proc & " Error"
On Error GoTo 0
Resume CleanExit
End Sub
score:1
I just provide this variant. It is working with array, so theoretically it is very quick. Probably no need to turn off the screen updating.
Sub test()
Dim lastRow As Long, i As Long
With Sheet1
lastRow = .Cells(Rows.Count, "D").End(xlUp).row
Dim vA As Variant 'Represents A2-A lastrow
vA = .Range("A2").Resize(lastRow - 1).Value
Dim vb As Variant 'Represents D2-D lastrow
vb = .Range("D2").Resize(lastRow - 1).Value
i = 0
Dim v As Variant
For Each v In vA
i = i + 1
If v = "Bol" Then
vb(i, 1) = vb(i, 1) * 1.19
ElseIf v = "Amazon" Then
vb(i, 1) = vb(i, 1) * 1.2
End If
Next v
.Range("D2").Resize(lastRow - 1).Value = vb ' Writing the values to the D column
End With
End Sub
Source: stackoverflow.com
Related Query
- Change the values in a column depending upon different criteria
- Copy a range of rows depending on criteria in a column and paste into a different sheet named as the criteria
- Change the entire row color based on different values in the Turn around time column
- VBA Macro to change vertical axis in column chart to the minimum and maximum values in selection
- Dynamically select a column using month and year, then sumif the values based on criteria in another column
- Compare the value of a Cell in a Column on one sheet with all the values in a column on another sheet. Color the row depending on the result
- How to change row color base on the values in column 1?
- Trying to send different Outlook messages depending on if "0" is in the column C,D and E next to email
- Sum all of the values in Column N, EXCEPT for when a specific criteria is met in Column M
- How to "merge/group by" rows in excel and add the values located on a different column in excel
- VBA Replacing variable ranges that have values > 0 depending on cell value of the first column in row
- Change color of cells if the value matches values of other worksheets values in a column
- I want to compare 3 different columns (B,C,D) values then want to get the higher value result in F column
- Return different values from a vba user form depending on the button pressed
- Highlight cells with different values than present in the column
- Finding the minimum and median values in a column if they match criteria using vba
- finding values in a different column of a different sheet then pasting it to the orignial sheet
- Change the color and shape of a bubble chart in excel based on value in different column
- Change the Range Into First and Last column with Values
- VBA Excel. How to search for a value, get the first row/first column values and insert them in a different sheet if they don't yet exist
- In Excel Need to get Sum of a Column based on values satisfying criteria in 6 different columns using VBA
- Change the value of each cell that meets criteria in a column
- Loop compares values in a column and inserts new row if different but ignores the first row if it's a unique value
- Filter and delete the criteria that I have filtered from a different column
- Replacing the values in a column depending on a match condition using VBA
- Excel vba for a range on column A copy the values of the different columns
- Check if the values from a column match the range from a different sheet
- I would like to take averages of values in a column depending on values in the cells of another column
- copy cell value to another column but if there is different value by same searching criteria put in the same row
- How to change the row values and column values in excel vba
More Query from same tag
- Display Row Values based on Nearest Numeric Match of Key
- excel datasource returning nulls with sql command
- Is there an excel function that will let me average a column with a specific title?
- Copy row contents that are true from specific columns from different worksheets into a particular worksheet
- Extract the initials of first name and last name as well as number to form an ID number
- VBA specify no value for optional argument
- .Find Optimal/Best Practice way to read several items from a Range
- Macro to Autofill
- Replace function in Excel does not work anymore after moving a worksheet
- Personal Macro Workbook has gone missing (AGAIN)!
- Copy row´s content to another rows but transpose in excel VBA
- Appy If statement in the pivot filter
- VBA FileDialog.Show restarts sub
- Why some SELECT statements open a RecordSet, while others return "Error 13, Type Mismatch"
- Can I use a VLookup that includes dates and tab names?
- How to set a series data with a variable in VBA (Excel)
- Delete All Text After Bookmark
- Odd problem - Form won't close when opening new form using WHERE
- VBA Excel Merging dynamic ranges from two sheets into one, 1004 paste error
- How to create different variables names while in a loop in VBA
- My excel macro generates errors inconsistently
- VBA Variable inside formula
- Hi, i'm currently trying to create a macro in VBA, which finds all the cells in a specific row, which doesn't contain a number
- How to correct code so that it runs or inserts formula in column to left of Range for cells that = "Metered"
- validate format string for numeric values in excel (dna)
- VBA Yes No link to click
- Creating charts in MS Word using from regular MS Word tables
- Copy table in email to Excel using VBA
- How to change swimlane orientation in Visio BPMN diagram using VBA
- Dynamically Create Bookmarks with VBA