I'm rather new to all of this and have looked everywhere.
I have a named range "Ruptures" (N14:P60) in sheet 7 in which I would like to find in column P values greater than 0 and paste corresponding cells N:P in sheet 9 F:H. I can't seem to search only column P.
This is what I've tried so far:
Dim cell As Variant
Dim count As Long
count = 0
With Sheet7
Set Rng = Sheet7.Range("Ruptures")
For Each cell In Rng
'But I only want to check cells from the P column (this is where I am stumped)
If cell.Value > 0 Then
Range(cell.Offset(0, -2), cell.Offset(0, 0)).Copy
Sheet9.Activate
Range("F14", "H14").Offset(count, 0).PasteSpecial (xlPasteValues)
count = count + 1
Sheet7.Activate
Next
End With
End If
End Sub
Thank so much in advance and have a great day ! :)
Ursula
This is iterating over the entire (multi-column) range:
Set Rng = Sheet7.Range("Ruptures")
For Each cell In Rng
You can limit this to the third column using this:
For Each cell in Rng.Columns(3)
I would also simplify the copy/paste to avoid unnecessary worksheet Activate and to use direct Value assignment from one range to the other (see here for more detail as well). And as noted in the comments, your Next statement can't be inside the If block:
For Each cell in Rng.Columns(3)
If cell.Value > 0 Then
Sheet9.Range("F14", "H14").Offset(count, 0).Value = Range(cell.Offset(0, -2), cell.Offset(0, 0)).Value
count = count + 1
End If
Next
This could be further refined using Resize methods:
For Each cell in Rng.Columns(3)
If cell.Value > 0 Then
Sheet9.Range("F14").Offset(count).Resize(1,3).Value = cell.Offset(0,-2).Resize(1,3).Value
count = count + 1
End If
Next
Related
I am trying to get VBA to look at values in one column, and then check if the same value exists in another column.
I am then trying to highlight the same number of cells in both columns where the same value shows up, meaning that if the same value shows up a different amount of times in one column than in the other, I need to highlight the same amount of cells in each column and leave any "excess" duplicate values without highlight.
The picture illustrates what I am trying to accomplish. EXCEL SCREENSHOT
As seen in the picture, the values have been highlighted to the degree that they show up in either column, leaving the additional duplicate values without highlight.
I tried this code but it did not work and highlighted cells that I did not expect to get highlighted. I tried to loop through the columns and ignore already highlighted cells.
Sub highlightMatchingValues()
'Declare variables
Dim cellC As Range, cellE As Range
'Loop through each cell with a value in column C
For Each cellC In Range("C:C").Cells
If Not IsEmpty(cellC) And cellC.Interior.ColorIndex = xlNone Then 'ignore empty cells and cells that are already highlighted
'Loop through each cell with a value in column E
For Each cellE In Range("E:E").Cells
If Not IsEmpty(cellE) And cellE.Interior.ColorIndex = xlNone Then 'ignore empty cells and cells that are already highlighted
If cellC.value = cellE.value Then 'check for a match
'Highlight both cells green
cellC.Interior.Color = vbGreen
cellE.Interior.Color = vbGreen
End If
End If
Next cellE
End If
Next cellC
End Sub
here comes a solution that can solve your problem
'Sheet name = sheetName
'First columns variables (column C = index 3)
Dim firstLine1 As Long
Dim lastLine1 As Long
firstLine1 = 1
lastLine1 = Worksheets("sheetName").Cells(Rows.Count, 3).End(xlUp).Row
'Second columns variables (column E = index 5)
Dim firstLine2 As Long
Dim lastLine2 As Long
firstLine2 = 1
lastLine2 = Worksheets("sheetName").Cells(Rows.Count, 5).End(xlUp).Row
'loop
For i = firstLine1 To lastLine1
For j = firstLine2 To lastLine2
If (Worksheets("sheetName").Cells(i, 3).Value = Worksheets("sheetName").Cells(j, 5)) Then
If (Worksheets("sheetName").Cells(j, 5).Interior.Color <> vbGreen) Then
Worksheets("sheetName").Cells(i, 3).Interior.Color = vbGreen
Worksheets("sheetName").Cells(j, 5).Interior.Color = vbGreen
Exit For
End If
End If
Next j
Next i
What I am trying to accomplish is:
If cells in column F contain a number, then convert it to a percentage
If cells in column F are empty and the corresponding cell in column G contain 0 then write in cell in column F "-"
If cells in column F dont contain a number and the corresponding cell in column G contain a number higher than 0 then write in cell in column F "Action Required"
Column G is formatted as number.
However, with the given code, everything becomes "-". Where is the trick?
Sub Replace()
Dim ws As Worksheet, dataLastRow As Long, cell As Range, MyRng As Range
Set ws = ThisWorkbook.Worksheets("MyTab")
Application.ScreenUpdating = False
dataLastRow = ws.Range("F" & Rows.Count).End(xlUp).Row
Set MyRng = ws.Range("F2:F" & dataLastRow)
' Loop through column F
For Each cell In MyRng
If cell = "" And cell.Offset(0, 1) = 0 Then
cell = "-"
ElseIf cell = "" And cell.Offset(0, 1) > 0 Then
cell = "Action Required"
ElseIf cell >= 0 Then
With MyRng
.NumberFormat = "0.00%"
.Value = .Value
End With
Else
End If
Next cell
Application.ScreenUpdating = True
End Sub
Your question looks weird: you get a list of data, you need to summarise those data and instead of putting the summary in another column, you decide to overwrite your data with your summary.
In case you change your mind, I've written this formula which creates the summary (not entirely correct, some small adaptations need to be done):
=IF(AND(ISBLANK(F1),G1=0),"-",IF(ISNUMBER(F1),F1,"Action required"))
(Oh, in case you use the formula, don't forget modifying the cell format into percentage.)
i have a list of names(Column A), the numbers in columns B to F are result of a formula. I'm trying to create a FOR LOOP code that will check columns B to F, if all cells in B to F are zero then the code should ignore the current row and skip to the next row; if any of the cells in columns B to F is greater than 0, then the code should get the corresponding name in Column A.
Example: If any of the cells in B2, C2, D2, and E2 is greater than 1, then i should get the name/value of A2. if all cells in B2, C2. D2, and E2 are all zeros, then proceed to check next row and do the same thing.
here's the code i used to try to get the names that has any of the 4 column cell values greater than 1
For i = 2 To LastCalcAnalystRowIndex '//wsCalculations.Cells(Rows.Count, "CP").End(xlUp).Row
'//Get Component from cell in column "BP"
Analyst = wsCalculations.Cells(i, "CP").Value
Component = wsCalculations.Cells(i, "CN").Value
weeknumber = wsCalculations.Range("BR2").Value + 3
If wsCalculations.Cells(i, "B").Value = 0 And wsCalculations.Cells(, "C").Value = 0 _
And wsCalculations.Cells(i, "D").Value = 0 And wsCalculations.Cells(i, "E").Value = 0 _
And wsCalculations.Cells(i, "F").Value = 0 Then
Exit For
Else
wsCalculations.Cells(i, "A").Value = wsCalculations.Cells(i, "CP").Value
End If
Next
using the code above, i tried to get the names which all 4 column values are not equal to zero, but the result i get is just a copy of the original list. i highlighted the rows i want my code to skip. i also included the result i get and the result i want to get.
Below is a sample data. My original data has 54 rows. .
can anyone please tell me what im getting wrong?
There's no real need for VBA.
Note that I have used a Table with structured references. You can change it to a range with normal references if you prefer.
If you have O365, you can use a helper column and a formula.
Add a helper column which SUM's the cells in each row (and you can hide that column if necessary).
eg: G2: =SUM(Table3[#[Column2]:[Column6]])
Then, assuming the data is in a Table named Table3 use the formula:
=INDEX(FILTER(Table3,Table3[sumRow]>0),0,1)
If you have an earlier version of Excel, you can use:
I2: =IFERROR(INDEX(Table3[Column1],AGGREGATE(15,6,1/(Table3[sumRow]>0)*ROW(Table3)-ROW(Table3[#Headers]),ROWS($1:1))),"")
and fill down the length of the table.
Not the solution but could shorten your initial code
Why not create a hidden column* that does an =SUM of the entire row
Then get the value from that
instead of using code to get the value of each 5 cells then adding it up.
edit: changed the 'hidden cell' to 'hidden column' :P
Try
Sub test()
Dim rngDB As Range
Dim rng As Range, rngSum As Range
Dim wsCalculations As Worksheet
Dim vR() As Variant
Dim n As Long
Set wsCalculations = ActiveSheet
With wsCalculations
Set rngDB = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
End With
For Each rng In rngDB
Set rngSum = rng.Offset(, 1).Resize(1, 5)
If WorksheetFunction.Sum(rngSum) > 0 Then
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = rng
End If
Next rng
With wsCalculations
If n Then
.Range("h2").Resize(n) = WorksheetFunction.Transpose(vR)
End If
End With
End Sub
can anyone please tell me what im getting wrong?
actually your shown code isn't consistent with your wording, so it's impossibile to tell all that's wrong
but for sure that Exit For is a logical error, since it actually gets you out of the loop when it first meets five zeros
so as far as this logical error is concerned, you should change that piece fo code to the following:
With wsCalculations
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(.Cells(i, 2).Resize(, 5), 0) < 5 Then ' when a row is eligible for math
' do your math
End If
Next
End With
where I used WorksheetFunction.CountIf() function that enables you to deal with different conditions since your wording wasn't clear about this item, too ("greater than 0", "all cells...are zero", "greater than 1")
I am quite new to VBA and after lots of searching I haven't been able to find any help to the following problem.
I have a fairly large and complex table containing a lot of data. The data within the table has been conditional formatted to have different color fills. Using the following code, I am able to count the number of cells of a certain color within each range.
However I am looking to replace the range with for example something along the lines of; IF column C value matches "Apples" AND IF row 3 value matches "Farm A" THEN count green fills within this area.
The code I am using so far is below.
Dim rng As Range
Dim lColorCounter As Long
Dim rngCell As Range
Sheets("Matrix").Select
Set rng = Sheet1.Range("F140:O150")
For Each rngCell In rng
If Cells(rngCell.Row, rngCell.Column).DisplayFormat.Interior.Color = RGB(185, 255, 185) Then
lColorCounter = lColorCounter + 1
End If
Next
Sheets("Summary").Activate
Sheet3.Range("C4") = lColorCounter
lColorCounter = 0
Hope this makes sense and any help will really be appreciated. Thank you!
As discussed in comments, this has a dynamic row loop (check for value of Apples) and a dynamic column loop (check for color of cells).
The range of the 2nd loop is determined by the size of your merged cell ("Farm A") which starts in cell C2. So if you change your Farm A merged cell to span 20 columns, the loop will expand to those 20 columns.
Option Explicit
Sub test()
Dim i As Long, FarmA As Integer, MyCell As Range, lColorCounter As Long
Dim Matrix As Worksheet: Set Matrix = ThisWorkbook.Sheets("Matrix")
Application.ScreenUpdating = False
With Matrix
FarmA = .Range("C2").CurrentRegion.Count + 2 'Determine size of merged cell "FarmA"
For i = 3 To .Range("B" & .Rows.Count).End(xlUp).Row 'Loop through used rows in Col B
If .Range("B" & i) = "Apples" Then 'If condition is met, move to next line, else, check next row
For Each MyCell In .Range(.Cells(i, 3), .Cells(i, FarmA)) 'set serach range
If MyCell.DisplayFormat.Interior.Color = RGB(185, 255, 185) Then 'search for format
lColorCounter = lColorCounter + 1
End If
Next MyCell
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox lColorCounter
End Sub
I need to get a VBA code to excel for following criteria.
If any cell in the range of B1 to B500 contains "TOTAL:", divide same row value in column V with same row value in Column P where "TOTAL:" text exists.
Answer should be in same row column M.
I tried to develop the code like this:
Sub test()
Dim r As Range
For Each r In Range("B1", Range("B" & Rows.Count).End(xlUp))
If r.Value Like "TOTAL:" Then
With Range("M1:M10")
r.Formula = "=V5/P1"
End With
End If
Next
End Sub
If you want to learn VBA, I'd recommend you to solve those problems on your own by searching for 'loop through range' and 'compare string' and so on. That would be much more valuable for you on a long-term.
Anyway, for now you can try this. Please note that it doesn't provide any error handling etc...
Search Range:
For row = 1 To Cells(ws.Rows.Count, "B").End(xlUp).row loops through the rows from 1 to the last row with a value in column B. If you, for some reason, want to exclude just that very last row and stop at the second last, just substract 1 from it. If you seriously want a fixed range, change the whole thing to For row = 1 To 500.
Sub test()
Dim ws As Worksheet
Dim row As Long
Set ws = Sheet1 'insert name of sheet
For row = 1 To Cells(ws.Rows.Count, "B").End(xlUp).row
If StrComp(Cells(row, 2).Value, "TOTAL:", vbTextCompare) = 0 Then
Cells(row, 13).Value = Cells(row, 22).Value / Cells(row, 16).Value
End If
Next row
End Sub