I am trying to use this code in Excel to get a product color from column AW and then replace the value in column J with the SKU for that product color. It works, except it pastes the formula in column AY for EVERY row, instead of just the rows where the column J value is "WCblack", so that causes it to run pretty slowly.
Any ideas how I can get it to only put the formula in rows where column J value is "WCblack"? Thanks!
Sub Macro1()
Dim lastRow As Long, i As Long
lastRow = Cells(Rows.Count, "K").End(xlUp).Row
For i = 2 To lastRow
If Cells(i, "J").Value = "WCblack" Then
Range("AY2:AY" & lastRow).Formula = "=TRIM(LEFT(AW2,FIND(CHAR(10),AW2)-1))"
If Cells(i, "AY").Value = "Color: Red" Then
Cells(i, "J").Value = "WCred"
ElseIf Cells(i, "AY").Value = "Color: Gold" Then
Cells(i, "J").Value = "WCgold"
ElseIf Cells(i, "AY").Value = "Color: Blue" Then
Cells(i, "J").Value = "WCblue"
End If
End If
Next
End Sub
Related
Sub Formatted_Salary()
Dim lastrow, Total As Integer
lastrow = 0
Total = 0
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lastrow To 1 Step -1
If Cells(i, 1) = "" Then
ActiveSheet.Rows(i).EntireRow.Delete
ElseIf Cells(i, 11).Value Then
Total = Total + Cell.Value (Problem Area)
End If
Next
newlastrow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(newlastrow + 1, 10).Value = "Total Base Salary"
Cells(newlastrow + 1, 11).Value = Total
Cells(newlastrow + 1, 11).Font.Color = vbGreen
End Sub
The line of code label as problem area is not working, and I would like some help. (im new to all is this). Basically what I would like the code to do is to delete all the blank rows and then add the total value of a column K and the print value at desired location. Thanks. Any help is appreciated.
I need to search in column B:B for a specific text, then if true paste other text to column L:L, exemple:
Sub teste()
Application.ScreenUpdating = False
last = Cells(Rows.Count, "B").End(xlUp).Row
For i = last To 1 Step -1
If (Cells(i, "B").Value) = "string_1" Then
Range("L2").Select
ActiveCell.FormulaR1C1 = "some_text_1"
'LastRow = Range("A" & Rows.Count).End(xlUp).Row
'Range("L2").AutoFill Destination:=Range("L2:L" & LastRow)
End If
Next i
End Sub
I can only paste the first text if true or fill the column L:L with the same text.
You mean something like that?
If column B is string_1 then copy column C to column L
For i = last To 1 Step -1
If (Cells(i, "B").Value) = "string_1" Then
'copy value from C to L
Cells(i, "L").Value = Cells(i, "C").Value
End If
Next i
You might benefit from reading
How to avoid using Select in Excel VBA.
Sub teste()
Application.ScreenUpdating = False
s1 = "first_text"
s2 = "second_text"
s3 = "third_text"
last = Cells(Rows.Count, "B").End(xlUp).Row
For i = last To 1 Step -1
If (Cells(i, "B").Value) = "string_1" Then
Cells(i, "L").Value = s1
ElseIf (Cells(i, "B").Value) = "String_2" Then
Cells(i, "L").Value = s2
ElseIf (Cells(i, "B").Value) = "string_3" Then
Cells(i, "L").Value = s3
End If
Next i
End Sub
I have two columns, Column A has a set of a few standard values and column B has all unique values. I'm only just experimenting with more complex ways of compiling data than the beginner level so I'm a bit at a loss.
I need to either have a lookup or create a macro that will list only the values in A (once each) but also display which values in B correspond to those in A
for example
A | B
va1|abc
va1|bcd
Va2|xyz
va3|zab
will show (in a single cell) the following
va1: abc, bcd
va2: xyz
va3: zab
Please help!
Option Explicit
Sub Test()
Dim i As Long, j As Long, k As Long
k = 1
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountIf(Range("C:C"), Cells(i, 1).Value) = 0 Then
Cells(k, 3).Value = Cells(i, 1).Value
For j = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(j, 1).Value = Cells(k, 3).Value And _
InStr(Cells(k, 4).Value, Cells(j, 2).Value) = 0 Then
If Cells(k, 4).Value = "" Then
Cells(k, 4).Value = Cells(j, 2).Value
Else
Cells(k, 4).Value = Cells(k, 4).Value & ", " & Cells(j, 2).Value
End If
End If
Next j
k = k + 1
End If
Next i
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
Cells(i, 3).Value = Cells(i, 3).Value & ": " & Cells(i, 4).Value
Cells(i, 4).ClearContents
Next i
End Sub
Edited for single cell
In case your requirement is to "have the grouped data", and not exactly "have one single string per A", you can do this with a "pivot table" putting A and B in the row labels, like in the following picture:
I am looking for a VBA code for the below scenario:
There are four columns (A, B, C, D) in an excel sheet and the code should populate the D column.
The logic should be
IF C2 = A2, then populate D2 with value in B2
else if C2 = A3, then populate D2 with B3 and so on till D2 gets right value.
The columns are long lists with 400 entries.
Try this:
Sub MySub()
Dim lastRow As Long, i As Long
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
For i = 2 To lastRow
If Cells(i, 1).Value = Cells(i, 3).Value Then
Cells(i, 4).Value = Cells(i, 2).Value
Else If Cells(i + 1, 1).Value = Cells(i, 3).Value Then
Cells(i, 4).Value = Cells(i + 1, 2).Value
End If
Next
End Sub
Sub test()
Dim x As Integer
Dim erow As Integer
'erow takes in the value of the last row number.
erow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For x = 1 To erow
For i = x To erow
If Cells(x, 3).Value = Cells(i, 1).Value Then
Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Cells(x, 4).Select
ActiveSheet.Paste
Application.CutCopyMode = False
i = erow
End If
Next i
Next x
End Sub
Is this what you need. It does this for every D column not only for 2nd D column.
Im trying to write a VBA script to compare two = rows and have the spreadsheet highlight the duplicate rows only if certain criteria is met, such as (Value of row, column a = Value of row-1, column) AND Value of row, column b > Value of row-1, column b) Then entirerow of the greater value in column b.font.color = vbRed.
Here is a section of the table I'm running...
Table Selection
Here is the code I am using...
Sub RemoveDuplicates()
Dim i As Long, R As Long
'Dim DeviceName As Range, SerialNumber As Range, LastContact As Range
Application.ScreenUpdating = False
R = Cells(Rows.Count, 1).End(xlUp).Row
'Set DeviceName = Columns(2)
'Set SerialNumber = Columns(3)
'Set LastContact = Columns(7)
For i = R To 2 Step -1
'If Cells(i, "F").Value > Cells(i - 1, "F").Value Then
'Code above doesn't work
If Cells(i, 3).Value = Cells(i - 1, 3).Value And Cells(i, 2).Value = Cells(i - 1, 2).Value Then
'If Cells(i, 3).Value = Cells(i - 1, 3).Value And Cells(i, 2).Value = Cells(i - 1, 2).Value And Cells(i, 5).Value > Cells(i - 1, 5).Value Then
'Code above doesn't work
Cells(i, 1).EntireRow.Font.Color = vbRed
End If
Next i
Application.ScreenUpdating = True
End Sub
I can get the duplicates to highlight, but when I try to introduce the greater than check, the system gets janky.
try a conditional formatting rule.
With worksheets("sheet1").usedrange.offset(1, 0).entirerow
.FormatConditions.Delete
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=and($a2=$a1, $b2=$b1, $f2>$f1)")
.font.Color = vbRed
End With
End With