I have some values on column A such as:
"A" "B"
1 ok
1 ok
1 me
2 next
2 next
2 next
My code goes and and color the row on "A" if it is all the same, what i want is if column "A" have all one's to check column "B" for the last value which is "me" if it's there, leave those rows with "1" in column A alone, if it's not, delete all the rows that have "1". Not sure how to accomplish that. any help is appreciated.
Dim i As Long
Dim initialPlaceHolderValue As String
Set UsedRng = ActiveSheet.UsedRange
FirstRow = UsedRng(1).Row
LastRow = UsedRng(UsedRng.Cells.Count).Row
r = WorksheetFunction.RandBetween(180, 255)
g = WorksheetFunction.RandBetween(180, 255)
b = WorksheetFunction.RandBetween(180, 255)
initialPlaceHolderValue = Cells(FirstRow + 1, 1).Value
For i = FirstRow + 1 To LastRow
myColor = RGB(r, g, b)
If Cells(i, 1).Value = initialPlaceHolderValue Then
Debug.Print Cells(i, 19).Value
Cells(i, 1).EntireRow.Interior.Color = myColor
Else
Dim myRange As Range
initialPlaceHolderValue = Cells(i, 1).Value
r = WorksheetFunction.RandBetween(180, 255)
g = WorksheetFunction.RandBetween(180, 255)
b = WorksheetFunction.RandBetween(180, 255)
Cells(i, 1).EntireRow.Interior.Color = RGB(r, g, b)
End If
Next i
The following code should achieve what you want (at least what I think you want, your question is not very easily understandable).
Sub RemoveIfNot1AndMe()
For Each cell In Range("Your Range In Column A")
If (cell.Value = "1") Then
If (Range(cell.Address).Offset(0, 1).Value <> "me") Then
Rows(cell.Row).EntireRow.Delete
End If
End If
Next cell
End Sub
Explanations
The loop will go through every cell in your row (could be your column) and if the value is 1 it will check if the cell next to it contains me and if it doesn't delete it.
Something like
"A" "B"
1 ok
1 ok
1 me
2 next
2 next
2 next
Will end up looking like this
"A" "B"
1 ok
1 ok
2 next
2 next
2 next
EDIT
Sub RemoveIfNot1AndMe()
Dim deleteRowsWithValue1 As Boolean
deleteRowsWithValue1 = False
For Each cell In Range("Your range")
If (cell.Value = "1") Then
If (Range(cell.Address).Offset(0, 1).Value = "me") Then
deleteRowsWithValue1 = True
End If
End If
Next cell
If (deleteRowsWithValue1) Then
For i = 1 To Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
If (Range("A" & i).Value = "1") Then
Rows(i).EntireRow.Delete
i = i - 1
End If
Next
End If
End Sub
Something like
"A" "B"
1 ok
1 ok
1 me
2 next
2 next
2 next
Will end up looking like this
"A" "B"
2 next
2 next
2 next
Here is a very basic, brute force approach for you:
Find if there is such a pair of cells: "1" in A-col and "m" in B-col
If Such a pair exist then look for any row with "1" in A-col and NOT "m" in B-column; WARNING: start this at the bottom of the range and look up to the top of the worksheet (otherwise deleting rows is likely to mess up your logic). Delete any such rows.
Redo the LastRow = ... bit since it will become smaller if you deleted any lines.
Do this between the LastRow = ... line and `r = ..." line.
Good luck and share with us your success.
And, btw, it's a good practice to declare ALL the variables if you do declare them at all (as you certainly should). Also, there is no need to declare any WITHIN a loop, over and over again, as you have done there with myRange; just move it to the top of the sub.
Related
Here is an example of what I am trying to accomplish:
I am trying to add an "x" in the next 3 blank cells that are next to a nonblank cell (from left to right). I do not want to overwrite any cells though. As you can see in the first row, only December and January are filled and I did not overwrite February.
Any ideas?
Sub sub1()
Dim irow&, icol&, n&
For irow = 2 To 6 ' rows
n = 0
For icol = 2 To 14 ' columns
If Cells(irow, icol) = "" Then
n = n + 1
If n <= 3 Then Cells(irow, icol) = "x"
Else
n = 0
End If
Next
Next
End Sub
For Each ID In Range("A2:A6") 'Change your range according your ID
For Each cell In ID.EntireRow.Cells 'Check each cell of ID's row
If cell.Value = "" Then
cell.Value = "x"
No = No + 1
Else
No = 0 'Recount
End If
If No = 3 Then Exit For 'stop after mark 3 x
Next
Next
you could use this
Option Explicit
Sub main()
Dim cell As Range, nCols As Long
With ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks)
For Each cell In .Cells
nCols = WorksheetFunction.Min(cell.Column - 1, 3)
If Intersect(cell.Offset(, -nCols).Resize(, nCols + 1), .Cells).Count < 4 Then cell.Value = "x"
Next
End With
End Sub
I'm having trouble with my loop not running throughout my entire sheet 1. If the value in Sheet 1 "tests" exist in sheet 2 "cancer". Then i want the value in sheet 2 "cancer" to be placed into sheet 1 "Tests". The code works except for the loop. Currently it only applies to the first record in my first sheet then stops.
Sub Testing()
Dim x As Long
Dim y As Long
x = 2
y = 2
Do While Sheets("Cancer").Cells(y, 1).Value <> ""
If LCase(Trim(Sheets("Cancer").Cells(y, 1).Text)) = LCase(Trim(Sheets("Tests").Cells(x, 3).Text)) Then
If Sheets("Tests").Cells(x, 4).Value = "" Then
Cells(x, 4) = (Trim(Sheets("Cancer").Cells(y, 3).Text))
x = x + 1
End If
End If
y = y + 1
Loop
End Sub
I would use two for loops
for y = 2 to 10000 'the range your values are found
if Sheets("Cancer").Cells(y, 1).Value <> "" then
for x = 2 to 10000 'the range your values are in
If LCase(Trim(Sheets("Cancer").Cells(y, 1).Text)) = LCase(Trim(Sheets("Tests").Cells(x, 3).Text)) and Sheets("Tests").Cells(x, 4).Value = "" Then
Cells(x, 4) = (Trim(Sheets("Cancer").Cells(y, 3).Text))
End If
next
end if
next
The reason for the loop not running throughout the entire sheet 1 is because of these two lines:
If LCase(Trim(Sheets("Cancer").Cells(y, 1).Text)) = LCase(Trim(Sheets("Tests").Cells(x, 3).Text)) and Sheets("Tests").Cells(x, 4).Value = ""
If these conditionals aren't both true, then x will never loop to its next iteration, and you'll have gone through looping through each value of Sheet2 "Cancer" while checking only the same record of Sheet1 "Tests".
You've almost qualified all of your ranges. You missed one. Try changing the line:
Cells(x, 4) = (Trim(Sheets("Cancer").Cells(y, 3).Text))
to
Sheets("Tests").Cells(x, 4) = (Trim(Sheets("Cancer").Cells(y, 3).Text))
I've what seems like a pretty simple application with looping and 'If..Then' statements but need some help on structuring it.
In very a basic example, I have a list numbers in column A and the values PM or AM listed in column B. I want to write a loop that will search every value in column B until the end of the data set, and add 12 to each value in column A each time column B has a value of PM. In a nutshell, it would look like this:
If column B = PM
then add 12 to its corresponding cell in column A
else move down to the next row and do the same thing until you reach an empty cell
There are many ways, here is a typical one:
Sub dural()
Dim i As Long
i = 1
Do While Cells(i, "B").Value <> ""
If Cells(i, "B").Value = "PM" Then
Cells(i, "A").Value = Cells(i, "A").Value + 12
End If
i = i + 1
Loop
End Sub
you can set it with For next loop and 2 variables. one for last row and the 2nd for the row count:
Sub Macro1()
Dim LastRow As String
Dim i As Integer
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 2).Value = "PM" Then Cells(i, 1).vlaue = Cells(i, 1).vlaue + 10
Next i
End
'
End Sub
This is another way to do this.
Option Explicit
Sub Add()
Dim rData As Range
Dim r As Range
Set rData = Cells(1, 1).CurrentRegion.Columns("B").Cells
For Each r In rData
If UCase$(r.Value) = "PM" Then
r.Offset(, -1).Value = r.Offset(, -1).Value + 12
End If
Next r
End Sub
I want to copy values from one column to another column (into the same row) if the cell contains the word IN and delete the original value. If not, the code should proceed to the next row and perform a new test. Thus the cell in the target column will remain empty.
When I run the code in Excel nothing happens, so I don't know what is wrong.
Ideally the code should jump to the next column (8) and do the same search and paste the value into the same column (5) when it is done with the first column, but this I haven't started with yet. So I do appreciate tips for that as well :)
Sub Size()
Dim i As Integer, a As String
i = 2
a = "IN"
Do While Cells(i, 7).Value <> ""
If InStr(Cells(i, 7), a) Then
'copying the value to another column but within the same row
Cells(i, 7).Copy Cells(i, 5)
Cells(i, 7).Clear
i = i + 1
Else
i = i + 1
End If
Loop
End Sub
I found out that my first cell in column 7 was empty and thus the Do While Cells(i, 7).Value <> "" wasn't working. Hence I'm refering to a different column that always contain data. Note that the solution code also jumps to the 2 next columns in order to search for the same word.
Sub Size()
Dim i As Integer, a As String
j = 0
i = 1
a = "IN"
Range("A1").Offset(i, 0).Select
For j = 0 To 2
Do Until Selection.Value = ""
If InStr(Range("G1").Offset(i, j).Value, a) Then
Range("E1").Offset(i, 0).Value = Range("G1").Offset(i, j).Value
Range("G1").Offset(i, j).Clear
i = i + 1
Range("A1").Offset(i, 0).Select
Else
i = i + 1
Range("A1").Offset(i, 0).Select
End If
Loop
i = 1
Range("A1").Offset(i, 0).Select
Next j
End Sub
Is there any efficient way or a correct way to copy and paste within the same worksheet? My code:
With ActiveWorkbook.Sheets("Sheet1")
For Each row In .Rows
If Not row.Columns("A:A") Is Empty Then 'error here
.Columns("A:A").Copy .Range("B1")
End If
Next rw
.Columns("A:A").Delete
End With
So in the code above, I would like to replace the column B with Column A only when the Column A of the cell is NOT empty.
For example:
1 Nil
Nil
24
4 Nil
4 Nil
12
3
7 Nil
2
Nil
8 Nil
Final result will be like this in Column B:
1
Nil
24
4
4
12
3
7
2
Nil
8
EDIT: Never mind, Solved.
With ActiveWorkbook.Sheets("Sheet1")
For rw = 1 To .Rows.Count
If (.Rows(rw).Columns("A:A").Value <> "") Then
.Rows(rw).Columns("A:A").Copy .Range("B" & rw)
End If
Next rw
.Columns("A:A").Delete
End With
With ActiveWorkbook.Sheets("Sheet1").UsedRange
For Each Row In .Rows
If Row.Cells(1, 1) <> "" Then
Row.Cells(1, 2) = Row.Cells(1, 1)
End If
Next
.Columns("A:A").Delete
End With
If you want to fire the the method when any cell from column changes use the method
Worksheet_Change, Here we are catching any change over the cell in the column J only
In this example we copy the values from the column E to G, without including the empty cells. We clear first the column G if this has any old value using this command Worksheets("Sheet1").Range("G:G").ClearContents
Private Sub Worksheet_Change(ByVal Target As Range)
idx = ActiveCell.Row
idxStr = CStr(idx)
labelIdx = "J" + idxStr
Dim ii As Long
Dim columnNumber As Long
ii = 1
columnNumber = 10
If ActiveCell.Column = columnNumber And ActiveCell.Value <> "" Then
Worksheets("Sheet1").Range("F1") = Range(labelIdx).Value
Worksheets("Sheet1").Range("G:G").ClearContents
For Each cell In Worksheets("Sheet1").Range("E:E")
If cell.Value <> "" And cell.Value <> "COLUMN LABEL" Then
Worksheets("Sheet1").Range("G" + CStr(ii)).Value = cell.Value
ii = ii + 1
End If
Next cell
End If
End Sub