I originally used some script where the blank rows in the first 3 columns of data in my worksheet were filled from the previous row. The script is:
Dim cell As Range, SearchRange As Range
On Error Resume Next
Set SearchRange = Columns("A:C").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not SearchRange Is Nothing Then
For Each cell In SearchRange
If cell.row > 1 Then cell = cell.Offset(-1, 0).Value
Next cell
End If
Although that is fine for blank rows in between those columns I have a problem where the blanks are alongside text in column D I do not wish to fill. I tried something like:
If Not Like "*FUEL*" Or Like "ACCOUNTS*"
yet I have trouble with the syntax in using this in a conditional statement. My pasted snip will make sense...I hope. I want to fill just the row beside the word Jacqui in Column D but not Fuel or Accounts. NB. The word Jacqui is not constant.
Excel Sample
Use the cell.row to reference column D.
Dim cell As Range, SearchRange As Range
On Error Resume Next
Set SearchRange = Columns("A:C").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not SearchRange Is Nothing Then
For Each cell In SearchRange
If cell.Row > 1 And Not (Cells(cell.Row, "D") Like "ACCOUNTS*" Or Cells(cell.Row, "D") Like "FUEL*") Then _
cell = cell.Offset(-1, 0).Value
Next cell
End If
Related
I've been trying to create a vba macros that finds duplicates in Column A but then checks to see if there is a certain value in Column B. (For ex: If a duplicate is found check to see if the cell next to it equals 202112. If a match is found then highlight both of them in yellow but if the cell does not match then don't highlight)
If match: enter image description here
If not a match: enter image description here
Sub Format()
Dim cell As Range
Dim wbook As Workbook
Dim wsheet As Worksheet
Dim sname As Range
Dim cname As Range
Dim rngA As Range
Dim dupA As Range
Dim dupB As Range
Dim strName As String
Set wbook = ActiveWorkbook 'Current Workbook
Set wsheet = Sheets("OFA_CP_OUT_202112_Without_Match") 'Worksheet Name
Set sname = Range("A2:H2426") 'Range for sorting and aligning columns A:H
Set cname = Sheets("OFA_CP_OUT_202112_Without_Match").Range("F2:F2426") 'Sheet Name & Range to format currency
Set rngA = Range("A2:A2426") 'Range to change column A to uppercase & find if a cell contains an A, B or S
Set dupA = wsheet.Range("A2:A2426") 'Range to find duplicates in column A
Set dupB = wsheet.Range("B2:B2426") 'Range to find year & month in column B (ex: 202112)
strName = "202112" 'year & month to search for in column B
'Looks for duplicates and highlights them yellow in column A & column B
For Each cell In dupA
If WorksheetFunction.CountIf(dupA, cell.Value) > 1 Then
cell.Interior.ColorIndex = 6
End If
Next cell
For Each cell In dupB
If InStr(cell.Value, strName) Then
cell.Interior.ColorIndex = 6
End If
Next cell
The only way I've gotten close is to just find duplicates in both columns.
Thanks for your help!!
You can try WorksheetFunction COUNTIFS. COUNTIFS can identify consolidated duplicates in multiple ranges. It returns result >1 if that data of consolidated rows duplicated:
COUNTIFS(dupA,"="&valueA,dupB,"="&valueB)
VBA looks like (looping through 1 column only, this sample in dupA):
For Each cell in dupA
If Application.CountIfs(dupA, "=" & cell.Value, dupB, "=" & cell.Offset(0, 1).Value) > 1 Then
cell.Interior.ColorIndex = 6
cell.Offset(0, 1).Interior.ColorIndex = 6
End If
Next cell
Here is the result:
Please make sure your cells have no highlight before you run, since the script will only change format of cells that do meet conditions. Or you can prepare a script to clear existing highlight (if any) of your data range. Just to prevent mess up of highlight (before - after).
I am automating a Workbook my team complete each month and have become stuck with a code for returning results on Find Greater Than.
I did not write this code originally, I found it on Stackoverflow and adapted for my purpose. Original code is from:
excel vba copy cells to another sheet if cell value is greater than 0
On my sheet "Agent Count" I have information in Columns A, B, C, with C containing a numerical count result. The code finds any count greater than 50.
When the code finds a count greater than 50 in Column C, it then copy and pastes the three cells to a new location on the same sheet, starting at "F2". Creating a separate summary table of counts greater than 50.
The code is successfully finding and copying and pasting counts greater than 50. However after pasting the result it is not moving down to the next row. So pastes the next result over the top of the previous result.
How to write the code so the paste moves down through the rows F2, F3, F4 etc for each result?
Sub FindGreaterThan50V3()
Dim range1 As Range
Dim cell As Range
Set range1 = Sheets("Agent Count").Range("c:c")
For Each cell In range1
If cell.Value > 50 Then
With Sheets("Agent Count")
.Range(.Cells(cell.Row, "a"), .Cells(cell.Row, "c")).Copy _
Sheets("agent count").Range("f2").End(xlUp).Offset(1, 0)
End With
End If
Next cell
End Sub
This:
.Range(.Cells(cell.Row, "a"), .Cells(cell.Row, "c")).Copy _
Sheets("agent count").Range("f2").End(xlUp).Offset(1, 0)
Should probably be:
.Range(.Cells(cell.Row, "a"), .Cells(cell.Row, "c")).Copy _
Sheets("agent count").Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
Couple more suggestions:
Sub FindGreaterThan50V3()
Dim range1 As Range, ws As WorkSheet
Dim cell As Range
Set ws = ThisWorkbook.Sheets("Agent Count")
'no need to scan the whole column
Set range1 = ws.Range("C1:C" & ws.cells(ws.Rows.Count, "C").End(xlUp).Row)
For Each cell In range1.Cells
If cell.Value > 50 Then
cell.Resize(1, 3).Copy _
ws.Cells(ws.Rows.Count, "F").End(xlUp).Offset(1, 0)
End If
Next cell
End Sub
In Range ("A2:A10") I have a vlookup equation.
I want to select the active cell in that range, if it has a value and ignore the other cells with the formula in the same range
This will Select the first cell in the range that does not have a formula:
Sub FindValue()
Dim rng As Range, r As Range
Set rng = Range("A2:A10")
For Each r In rng
If r.HasFormula Then
Else
r.Select
Exit Sub
End If
Next r
End Sub
If all the cells in the range have formulas, Selection is not changed.
If in range "A2:A10" you have formulas, but also cells without any formula, you can put the last one category in another range in this way:
Dim rng As Range, c As Range
Set rng = Range("A2:A10")
Set rng = rng.SpecialCells(xlCellTypeConstants) 'only cells without formula
For Each c In rng.cells
c.Select
Debug.Print c.Address 'if you want the first one, put here Exit For
Next
If no cells without formula, the above code will raise an error. It can be caught with some error handling, but I only tried showing a shor way of doing it.
I am trying to highlight a cell if it doesn't equal the value defined in a worksheet range.
I am checking each cell in the range "ADS_Export[ADS_208_SZ]" against Worksheets(ADS_Validator").Range("E3:E500") but it doesn't like the range E3:E500.
Seems to work if I just put E3 but all after the first cell check are incorrect as its checking against the third row, not the next row in the worksheet range (E4 etc.).
It needs to check the first value in the ADS_Export range against the first value in the worksheet range which starts at E3 and then does the next one. Also, need to redefine to highlight if not equal instead of equal.
Only just getting into VBA so my knowledge is very limited.
Sub IF_Loop()
Dim cell As Range
For Each cell In Range("ADS_Export[ADS_208_SZ]")
If cell.Value = Worksheets("ADS_Validator").Range("E:E").Value Then
cell.Interior.Color = 65535
End If
Next cell
End Sub
Try this code, please:
Sub IF_Loop()
Dim cell As Range, celVal As Range, lastRow As Long
lastRow = Worksheets("ADS_Validator").Range("E" & Rows.Count).End(XlUp).row
For Each cell In Range("ADS_Export[ADS_208_SZ]")
For Each cellval In Worksheets("ADS_Validator").Range("E3:E" & lastRow)
If cel.value = celVal.value Then
cell.Interior.Color = 65535
End If
Next
Next cell
End Sub
I am trying to get the row number of a cell in a range that I specify with vba. I want to get the row number of the cell in the range but what I am getting is the row number of the cell in the worksheet.
This is the vba code I am using currently. I have set a range and within the range I search for a cell that contains the text string "C". Once I have found the cell I want to make changes to the value in the second column of the range.
Sub trial2()
Dim ActiveWB As Workbook
Dim ActiveWS As Worksheet
Dim rng As Range, findCell As Range
Set ActiveWB = ActiveWorkbook
Set ActiveWS = ActiveWB.ActiveSheet
Set rng = ActiveWS.Range("B4", "C10")
With rng
Set findCell = .Cells.Find(what:="C")
End With
rng.Cells(findCell.Row, 2).Value = "change to something."
End Sub
Before running the code:
After running the code:
the cell value that contains "C" is in the 6th row of the worksheet, but in the 3rd row of the range. I was wondering how do I get the 3rd row of the range. I am aware that I can just offset the cell by 1 column to solve this problem, but I am curious about getting row numbers of cells in respect to a defined range.
One option is to adjust based on the number of the first row of rng, using simple math.
rng.Cells(findCell.Row - rng.Row + 1, 2).Value = "change to something."
In this case 6 - 4 + 1 = 3.
You can use:
Option Explicit
Sub test()
Dim rng As Range
With ThisWorkbook.Worksheets("Sheet1")
'If your searching area for A,B,C etc is from B4 to B10 just use
Set rng = .Range("B4:B10").Cells.Find(what:="C")
'If your searching area for A,B,C etc is from B4 to C10 just use
Set rng = .Range("B4:C10").Cells.Find(what:="C")
If Not rng Is Nothing Then
'Way 1
.Cells(rng.Row, rng.Column + 1).Value = "change to something."
'Way 2
rng.Offset(0, 1).Value = "change to something."
Else
MsgBox "No ""C"" found."
End If
End With
End Sub