I have this big excel file that is automated to do some processes. Today, I figured there is an issue with one of the columns and I need to fix it. to fix it I am generated this code below to filter column N to show all '#N/A'. with the filtered rows, I want to check and see if the offset to the right 2 columns has the value "Available". if it does, I want to loop through all column N and replace the '#N/A' with 'Unkown'. but the code I generated only works for the first filtered cell and doesn't loop.
Sub tess()
ActiveSheet.Range("$C$1:$AR$468").AutoFilter Field:=12, Criteria1:="#N/A"
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(, 12).Select
Dim lr
lr = ActiveSheet.UsedRange.Rows.CountLarge
For Each cell In Range("n1:n" & lr)
If ActiveCell.Value = CVErr(xlErrNA) And ActiveCell.Offset(, 2).Value = "Available" Then
ActiveCell.Value = "Unkown Person"
End If
Next cell
End Sub
Thank you.
you can avoid looping by adding another filter:
Sub tess()
With ActiveSheet.Range("$C$1:$AR$468")
.AutoFilter Field:=12, Criteria1:="#N/A"
.AutoFilter Field:=14, Criteria1:="Available"
If Application.WorksheetFunction.Subtotal(103, .Columns(12)) > 1 Then .Offset(1, 11).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Value = "Unkown Person"
.Parent.AutoFilterMode = False
End With
End Sub
You should refer to "cell" within your For loop, not "ActiveCell".
Related
Below is the code that I came up with, however, the issue lies in the 3rd line wherein the filtered data does not necessarily start in row 2. If the first data point satisfying the criteria is located at row 150, then it would return an error:
Total_Rows_Compiled = Worksheets("Compiled").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Compiled").Range("$A$1:$G$52818").AutoFilter Field:=1, Criteria1:=Worksheets("Sheet1").Cells(l, 1)
Worksheets("Compiled").Range("A2:G" & Total_Rows_Compiled).SpecialCells(xlCellTypeVisible).Select
There doesn't appear to be anything substantially wrong with your code. With that in mind, the following is a combination of methods that I have found to be reasonably error free.
with Worksheets("Compiled")
.activate
if .autofiltermode then .autofiltermode = false
Total_Rows_Compiled = .Range("A" & .Rows.Count).End(xlUp).Row
with .range("A1:G" & Total_Rows_Compiled)
.AutoFilter Field:=1, Criteria1:=Worksheets("Sheet1").Cells(l, 1)
with .resize(.rows.count-1, .columns.count).offset(1, 0)
if cbool(application.subtotal(103, .cells)) then
.SpecialCells(xlCellTypeVisible).Select
end if
end with
end with
end with
You could loop through the Areas:
Dim filterRange As Range, filteredRange As Range, area As Range
Set filterRange = Worksheets("Compiled").Range("$A$1:$G$52818")
filterRange.AutoFilter Field:=1, Criteria1:=Worksheets("Sheet1").Cells(l, 1)
Set filteredRange = Intersect(filterRange, filterRange.Offset(1, 0)).SpecialCells(xlCellTypeVisible) 'remove headers
If Not filteredRange Is Nothing Then
For Each area In filteredRange.Areas
'do something with area
Debug.Print area.Address
Next area
End If
The following data, when filtered on "test", returns the ranges (areas) B2:F2 and B4:F5 as required
Generally my macro goes through every "O" cell, checks if the row meets given requirements (not mentioned in this part of code) and copies surrounding cells on the side. I have two columns used in this part: "contract no"(M), "date"(O). The problem is that I try to use below method to go up to last the contract number and copy it as well.
I do not get any error but the contract cell value does not paste. Could you tell me what I've done wrong?
If ActiveCell.Offset(0, -2) = "" Then
'Go up find contract number copy
ActiveCell.Offset(0, -2).Select
Do Until ActiveCell.Value <> ""
ActiveCell.Offset(-1, 0).Select
Loop
ActiveSheet.Range("M" & ActiveCell.Row).Copy _
Destination:=ActiveSheet.Range("V" & ActiveCell.Row)
'Go down and return to the last active cell
Do Until ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 2).Select
End If
You didn't select the desired cell
Problem lies in this loop:
'Selecting cell from a column to the left
ActiveCell.Offset(0, -2).Select
'Condition: cell value is not empty string
Do Until ActiveCell.Value <> ""
'Selecting cell from previous row in the same column
ActiveCell.Offset(-1, 0).Select
Loop
You're leaving the loop before you can .Select a cell.
Use this loop instead:
'Selecting cell from a column to the left
ActiveCell.Offset(0, -2).Select
'Condition: cell value is not empty string
Do
'Selecting cell from previous row in the same column
ActiveCell.Offset(-1, 0).Select
Loop Until ActiveCell.Value <> ""
the issue lays in your keeping relying on ActiveCell after
ActiveCell.Offset(-1, 0).Select
statement, that changes it ...
you're actually playing with fire when using ActiveCell together with Select/Selection coding pattern!
since I cannot see what's behind the code you showed, I must keep using ActiveCell reference and amend your code as per comments:
Dim cellToCopy As Range
With ActiveCell 'reference currently "active" cell
If .Offset(0, -2) = "" Then 'if the cell two columns left of referenced (i.e. "active") cell is empty...
Set cellToCopy = .Offset(0, -2).End(xlUp) '... set cell to copy as the first not empty one above the cell two columns left of referenced (i.e. "active") cell
Else '... otherwise
Set cellToCopy = .Offset(0, -2) 'set cell to copy as the one two columns left of referenced (i.e. "active") cell
End If
cellToCopy.Copy Destination:=Range("V" & .Row) 'copy the cell set as the one to be copied and paste it column V cell same row as reference (i.e. "active") cell
End With
Try not to use ActiveCell Your code can do quite unpredictable things to your worksheet if the wrong cell was selected, and so can my "improvement" thereof below.
Sub FindAndCopy()
Dim Ws As Worksheet
Dim R As Long, C As Long
With ActiveCell
Set Ws = .Worksheet
R = .Row
C = .Column
End With
With Ws
If Len(Trim(.Cells(R, C - 2).Value)) = 0 Then
'Go up find contract number copy
Do Until Len(.Cells(R, C - 2).Value)
R = R - 1
Loop
.Cells(R, "M").Copy Destination:=.Cells(ActiveCell.Row, "V")
End If
End With
End Sub
I think the ActiveCell component in this code is still a source of great danger. However, as you see, at least the code doesn't change it which dispenses with the necessity of going back to it in the end.
I am having an issue with VBA that I can't seem to find an answer to online. I only started teaching myself a couple of weeks ago so apologies if this is a fairly simple answer...
I am trying to write a macro where the entire row is un-coloured (Is that a word??) based on a value in column E and the equivalent value in column AN (same row). What I have so far is:
For Each cell In Sheets(5).Range("E9:E" & LastRow)
If (cell.Value = "BA" Or cell.Value = "NH" Or cell.Value = "AD") Then
If ActiveCell.Offset(0, 35) > 7 Then
cell.EntireRow.Interior.color = xlNone
End If
Next cell
The only problem is, when I try to run it gives the 'Compile error: Next without For' error message.
?? Am I missing something... there is a 'For'...
If I remove the below line then the code runs,
If ActiveCell.Offset(0, 35) > 7 Then
but it's not the output i require as all of the BA, NH & AD values in column A have their entire row un-coloured regardless of whether they are >7 or <7.
Is the error caused by the IF-THEN-IF statement?
Try this:
For Each cell In Sheets(5).Range("E9:E" & LastRow)
If (cell.Value = "BA" Or cell.Value = "NH" Or cell.Value = "AD") Then
If ActiveCell.Offset(0, 35) > 7 Then
cell.EntireRow.Interior.color = xlNone
End If // You are missing this
End If
Next cell
You have another issue besides not closing the If with End If.
You are looping on Cell with For Each Cell In Sheets(5).Range("E9:E" & LastRow)
Then you are testing to see if Cell.Value = "BA" or ...etc
However, afterwards you are checking If ActiveCell.Offset(0, 35) > 7 Then, I think ActiveCell meant to be Cell as well.
One last thing, instead of using multiple Or, you can use Select Case.
Code
For Each Cell In Sheets(5).Range("E9:E" & LastRow)
Select Case Cell.Value
Case "BA", "NJ", "AD"
If Cell.Offset(0, 35) > 7 Then
Cell.EntireRow.Interior.Color = xlNone
End If
End Select
Next cell
you could use AutoFilter():
With Sheets(5)
With .Range("E8", .Cells(.Rows.Count, "E").End(xlUp)).Resize(, 36)
.AutoFilter Field:=1, Criteria1:=Array("BA", "NJ", "AD"), Operator:=xlFilterValues
.AutoFilter Field:=36, Criteria1:=">7"
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Interior.Color = xlNone
End With
.AutoFilterMode = False
End With
I have 4 tabs in my excel workbook: Main Tracking, In Progress, Completed, and Removed. Within the Main Tracking sheet is a list of hundreds of tasks. Columns A through G hold information on each task and column "H" holds a drop down list with the current status of the task. The idea is to be able click on the drop down in Column "H" and adjust the status and if "In Progress" is selected the task in that row will be moved to the "In Progress" tab.
However, the problem I run into is within the "In progress" sheet, I have columns for additional input that were not in the "Main Tracking" sheet. I would also like to retain the "Status" column as the last column to the right in each sheet. In essence I would dropping the data from columns "A:G" into the corresponding "A:G" columns in the "In Progress" tab, but the status column (column "H") would move to the right of my 3 additional columns (so column "K" in this case). Does anyone know a way to do this?
I know this was a long winded question, but any help would be greatly appreciated. Thanks!
Below is my code to move the data to different cells:
Option Explicit
Sub MoveRows()
Application.ScreenUpdating = False
With Worksheets("Main Tracking")
With .Range("H1", .Cells(.Rows.Count, "H").End(xlUp))
FilterAndCopy .Cells, "In Progress"
FilterAndCopy .Cells, "Completed"
FilterAndCopy .Cells, "Remove"
End With
End With
Application.ScreenUpdating = True
End Sub
Sub FilterAndCopy(rng As Range, filterStrng As String)
With rng
.AutoFilter Field:=1, Criteria1:=filterStrng
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
With .Resize(.Rows.Count).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow
.Copy Destination:=Worksheets(filterStrng).Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Delete
End With
End If
.Parent.AutoFilterMode = False
End With
End Sub
It's tricky working with filtered ranges in-place so easier to move the last column after the paste...
Sub FilterAndCopy(rng As Range, filterStrng As String)
Dim shtDest As Worksheet, rngDest As Range
Set shtDest = Worksheets(filterStrng)
Set rngDest = shtDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
With rng
.AutoFilter Field:=1, Criteria1:=filterStrng
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
With .Resize(.Rows.Count).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow
.Copy Destination:=rngDest
.Delete
End With
With shtDest.Range(rngDest, shtDest.Cells(.Rows.Count, 1).End(xlUp)).Offset(0, 7)
.Cut Destination:=.Offset(0, 3)
End With
End If
.Parent.AutoFilterMode = False
End With
End Sub
I am trying to select the first visible cell directly beneath the header of a filtered column. The code I am getting is as below, but I have to problems with this code. First, the first line of code is using the current active range of the file. It is highly likely that this file will change and this range will not be the same. How can I make it work for any file I would use it on? Second, if I use a totally different file with the same column format, the first visible cell under Column J could be J210. How can I make this work for any array of variables?
Sub Macro16()
'
' Macro16 Macro
'
'
ActiveSheet.Range("$A$1:$R$58418").AutoFilter Field:=12, Criteria1:= _
"Sheets"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[1],3)"
Selection.FillDown
End Sub
Sub FirstVisibleCell()
With Worksheets("You Sheet Name").AutoFilter.Range
Range("A" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End With
End Sub
Untested but:
Sub Macro16()
With ActiveSheet.Range("A1").CurrentRegion
.AutoFilter field:=12, Criteria1:="Sheets"
If .Columns(1).SpecialCells(xlCellTypeVisible).count > 1 Then
With .Columns(10)
.Resize(.rows.count - 1).offset(1).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=RIGHT(RC[1],3)"
End With
End If
End With
End Sub
I prefer non-destructive methods of determining whether there are visible cells to work with after a filtering operation. Since you are filling in column J with a formula, there is no guarantee that column J contains any values tat can be counted with the worksheet's SUBTOTAL function (SUBTOTAL does not count rows hidden by a filter) but the formula you are planning to populate into column J references column K so there must be something there.
Sub Macro16()
With ActiveSheet
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, 1).CurrentRegion
.Columns(12).AutoFilter Field:=1, Criteria1:="Sheets"
With .Resize(.Rows.Count - 1, 1).Offset(1, 9)
If CBool(Application.Subtotal(103, .Offset(0, 1))) Then
.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=RIGHT(RC[1],3)"
End If
End With
.Columns(12).AutoFilter Field:=1
End With
End With
End Sub
Something like this might work...
Sub Macro16()
Dim ARow As Long, JRow As Long, ws1 As Worksheet
ws1 = Sheets("NAME OF SHEET WITH DATA")
ARow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1
ws1.Range("$A$1:$R$" & ARow).AutoFilter Field:=12, Criteria1:="Sheets"
JRow = ws1.Range("J" & ws1.Rows.Count).End(xlUp).Row + 1
ws1.Range("J" & JRow).FormulaR1C1 = "=RIGHT(RC[1],3)"
ws1.Range("J" & JRow).FillDown
End Sub