I wrote VBA code to hide the rows in my chart where in the cell of column G the value "XYZ" occurs.
i = 4 ' row to begin with
j = Cells(i, 7).End(xlDown).Row
clmn = 7 ' column G
mark = False
For row = j To i Step -1
If (Cells(row, clmn).Value = "XYZ") Then
If mark Then
Union(Selection, Rows(row)).Select
Else
Rows(row).Select
mark = True
End If
End If
Next row
Selection.EntireRow.Hidden = True
This works totally fine. Now after working in this modifies chart I'd like to add a second attaching VBA code so that all the hidden rows with "XYZ" in column G reappear BUT only if in column A of the same row there stands "ABC". So not all of the hidden rows should unhide.
How do I have to modify my own code to have this done?
you could use AutoFilter and go like follows:
Sub UnhideThem()
Dim visbileRng As Range
With Range("G3", Cells(Rows.Count, "A").End(xlUp)) ' reference columns A:G from row 3 (headers) down to column A last not empty row
Set visbileRng = .SpecialCells(xlCellTypeVisible) ' store currently visible range
.AutoFilter field:=1, Criteria1:="ABC" ' filter referenced range on its first column (i.e. "A") with value "ABC"
.AutoFilter field:=7, Criteria1:="XYZ" ' filter referenced range on its 7th column (i.e. "A") with value "ABC"
With .Resize(.Rows.Count - 1).Offset(1) ' reference "data" rows only (i.e skip "header" row)
If CBool(Application.Subtotal(103, .Cells)) Then Set visbileRng = Union(visbileRng, .SpecialCells(xlCellTypeVisible)) 'if any filtered row in referenced range then add it to 'visbleRng'
End With
.Parent.AutoFilterMode = False ' remove filters
.EntireRow.Hidden = True 'hide all referenced range rows
visbileRng.EntireRow.Hidden = False ' unhide only rows to set visible
End With
End Sub
As Redji comment, just add a condition to your If clause. anyway, I don't prefer using the union and select approach.
If Cells(row, clmn).Value = "XYZ" and _
Cells(row, 1).Value = "ABC" Then
' do the selection if you like
Selection.EntireRow.Hidden = false
you also can use the specialcells as well. for instance, if your range is A4:G & j you can address this code in your chart.
range("a4:g" & j).Rows.SpecialCells(xlCellTypeVisible)
Regards,
M
Related
When my data are raw and unfiltered I can select them and Selection.Rows.Count returns the valid number.
After the AutoFilter it returns a number as if I selected the rows that were not visible, even though Selection.Copy does not copy other than selected rows.
How do I get the valid count of selected rows?
I tried Selection.SpecialCells(xlCellTypeVisible).Rows.Count.
EDIT
I use filter in another macro and then select by hand rows I want to add to another sheet.
I did two buttons, one to filter my table and the second to move selected rows to another sheet.
Sub ajout_commande()
Set DataSheet = ThisWorkbook.Worksheets("Prepa Commandes")
Dim a As Range, b As Range
Set a = Selection
i = 0
s = Selection.SpecialCells(xlCellTypeVisible).Count
For Each b In a.Rows
i = i + 1
DataSheet.Cells(6, 1).EntireRow.Insert
DataSheet.Range("A1:Z1").Copy DataSheet.Cells(6, 1).EntireRow
Next
Dim r1 As Range, r2 As Range, r3 As Range
Let copyrange1 = "E1" & ":" & "I" & i
Let copyrange2 = "BK1" & ":" & "BM" & i
Set r1 = a.Range(copyrange1)
Set r2 = a.Range(copyrange2)
Set r3 = Union(r1, r2)
r3.Copy
DataSheet.Cells(6, 1).PasteSpecial xlPasteValues
MsgBox s & " and " & i
End Sub
Here my table is filtered and I want to add selected rows to another sheet but the Selection.Rows.Count returns more rows than I selected because it counts the non visible rows, even though Selection.copy works.
For this example Selection.Rows.Count = 28 because of non visible rows between rows 10 and 20, 21 and 25 etc.
Is there a function to get the number I want (on this image 16)?
It depends on how you are using it. This works just fine for me
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
'~~> Specifying the complete address is the key part
With Range("A1:C6") '<~~ Filter, offset(to exclude headers)
.AutoFilter Field:=YOURFIELDNUMBER, Criteria1:=YOURCRITERIA
Debug.Print .Offset(1, 0).SpecialCells(xlCellTypeVisible).Rows.Count
End With
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
Test
Sub Sample()
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
With Range("A1:C6") '<~~ Filter, offset(to exclude headers)
.AutoFilter Field:=1, Criteria1:="Sid"
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Rows.Count
End With
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
End Sub
Well, the following would work if your selection was contiguous:
Selection.Columns(1).SpecialCells(xlCellTypeVisible).Count
However, from your screenshot I can see that your selections may be non-contiguous ranges (aka multiple areas selected), so you can use this function I created as a starting point:
Function countVisibleSelectedRows()
Dim count As Integer
count = 0
For Each Area In Selection.Areas
count = count + Area.Columns(1).SpecialCells(xlCellTypeVisible).count
Next
countVisibleSelectedRows = count
End Function
When you have multiple ranges selected, Excel calls each of those ranges an "area". In this function, we loop over each "area" in the Selection.Areas collection.
I know this is a late post to this question, but maybe this will help someone in the future. I find the following code snippet works well to count the number of visible rows in a range after being filtered.
Sub CountVisibleRows()
'only count the visible rows in the range
Dim lRow As Long, vis_lr As Long, DstWs As Worksheet
Set DstWs = ActiveSheet
lRow = DstWs.UsedRange.Rows.Count
'vis_lr = DstWs.Range("B2:B" & lRow).SpecialCells(xlCellTypeVisible).Count 'doesn't seem to work with non-contiguous rows
With DstWs
vis_lr = Application.WorksheetFunction.Subtotal(3, Range("B2:B" & lRow))
End With
Debug.Print vis_lr
End Sub
What I am trying to accomplish here is
1) Is to iterate the values in column O and for the ones that are not null - filter the worksheet titled DATA to only show values where Column B = X and use VLOOKUP() to return the lookup values to the corresponding row in Column P
2) If column O is null then filter the sheet titled DATA to only show values where Column B <> X and use VLOOKUP() to return the lookup values to the corresponding row in Column P.
I attempted the syntax below but I am getting an error of
Method 'Rarnge' of object '_Worksheet' failed
What do I need to do differently in my code below to get the syntax to return the values I desire?
Dim destSheet As Worksheet: Set destSheet = Sheets("Main")
For i = Range("A" & Rows.Count).End(3).Row To 2 Step -1
If Not IsEmpty(Cells(i, "O").Value) Then
Sheets("Data").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$C").AutoFilter Field:=2, Criteria1:="<>"
Sheets("Main").Select
Application.CutCopyMode = False
form2 = "=IFERROR(VLOOKUP(RC[-15],Lookup!C[-15]:C[-13],3,FALSE),"""")"
destSheet.Range("P:P" & lr).Formula = form2
Else
Sheets("Data").Select
Selection.AutoFilter
Sheets("Main").Select
Application.CutCopyMode = False
form3 = "=IFERROR(VLOOKUP(RC[-15],Lookup!C[-15]:C[-13],3,FALSE),"""")"
destSheet.Range("P:P" & lr).Formula = form3
End If
Next i
It was a bit hard to understand for me what you are trying to do, please correct me if I get you wrong.
First of all selecting sheets is not a preferred method while running macros, unless you intentionally do it, so avoid it.
Secondly, you don't need to filter anything, you can control it by checking conditions within your code. You don't do things physically, you do them theoretically within your code, and display the output.
Have a look at this code and ask wherever you need help to understand.
Sub VLookups()
Dim destSheet As Worksheet: Set destSheet = Sheets("Main")
Dim i As Long
Dim myVal As Variant
Set lookupRange = Sheets("Data").Range("$A:$C") 'This is your lookup range
For i = 2 To Range("O" & Rows.Count).End(xlUp).Row 'Iterate from 2nd row till last row
myVal = Application.VLookup(destSheet.Cells(i, "A").Value, lookupRange, 2, False)
If IsError(myVal) Then GoTo Skip 'If searched value not found then skip to next row
If Not IsEmpty(Cells(i, "O").Value) Then 'If Cell in Column O not empty
If myVal = "YOUR X VALUE FOR COLUMN B" Then 'If Your Column B X value exists
destSheet.Cells(i, "P").Value = Application.VLookup(destSheet.Cells(i, "A").Value, _
lookupRange, 3, False) 'Column P Cell is populated by Data Sheet Column C Cell
End If
Else 'If Cell in Column O empty
If myVal <> "YOUR X VALUE FOR COLUMN B" Then 'If Your Column B X value not exists
destSheet.Cells(i, "P").Value = Application.VLookup(destSheet.Cells(i, "A").Value, _
lookupRange, 3, False) 'Column P Cell is populated by Data Sheet Column C Cell
End If
End If
Skip:
Next i
End Sub
I understand that a match function is needed to look up values to the left rather than a right (VLOOKUP).
My want to click the macro button to display the items of the previous two columns, if the cell (is past its due date), and build an array of items which are past its due date.
Sub ItemRegister()
Application.Workbooks("Current.xlsm").Worksheets("Sheet1").Activate
On Error GoTo MyErrorHandler:
Dim Today As Date
Dim InspectionDate As Range
Dim ItemRow As Long
Dim ItemCol As Long
Dim Check As Variant
Today = Date
Set InspectionDate = [G4:G500]
Set TableC = [A4:A500]
Set TableS = [B4:B500]
Set DateArray = [G4:G500]
ItemRow = [G4].Row
ItemCol = [G4].Column
For Each Cell In InspectionDate
Check = Application.Match(Cell, DateArray, 0) 'need to fix match up
If Cell = "" Then
Item = ""
Serial = ""
If Cell <= Today Then
Item = Application.WorksheetFunction.Index(TableC, Check)
Serial = Application.WorksheetFunction.Index(TableS, Check)
Else
Item = ""
Serial = ""
End If
ItemRow = ItemRow + 1
End If
Next Cell
Exit Sub
MyErrorHandler:
If Err.Number = 1004 Then
MsgBox "An error has occured - please ensure that cells have not been altered in anyway - Something is wrong with code, Debug It" 'Remove this, when process is completed
Else
MsgBox "The item(s) that need inspection is/are: " & vbNewLine & vbNewLine & Item & "-" & Serial
End If
End Sub
Thanks in advance.
you could adopt an AutoFilter() approach;
Option Explicit
Sub main()
Dim area As Range
Dim iCell As Long
With Application.Workbooks("Current.xlsm").Worksheets("Sheet1") '<--| reference relevant worksheeu
With .Range("G3", .Cells(.Rows.COUNT, "G").End(xlUp).Offset(1)) '<-- reference its column "G" cell from row 3 down to last not empty cell
.AutoFilter Field:=1, Criteria1:="<=" & CDbl(Date) '<--| filter referenced column on dates preceeding or equal today's date
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell filtered other than header (which is in row 3)
With .SpecialCells(xlCellTypeVisible) '<--| reference columnn "G" filtered cells
ReDim Item(1 To .COUNT) '<--| size Item array to the number of referenced (i.e. filtered) cells
ReDim Serial(1 To .COUNT) '<--| size Serial array to the number of referenced (i.e. filtered) cells
For Each cell In .Cells '<--| loop through referenced (i.e. filtered) cells
iCell = iCell + 1 '<--| update cell counter
Item(iCell) = cell.Offset(, -6).Value '<--| retrieve value in column "A" cell at current filtered cell row
Serial(iCell) = cell.Offset(, -5).Value '<--| retrieve value in column "G" cell at current filtered cell row
Next cell
End With
End If
End With
.AutoFilterMode = False '<--| show all rows back
End With
End Sub
I have an issue with filling blank cells of a column.
I have 3 Column headings in A, B, C.
Under that I have variable amounts of rows, but column A and B will always have data.
Column C could have gaps. How could I do something similar to:
Edit > Go To > Special > Blanks, type = in the formula bars, hit the up arrow then Ctrl+Enter
EXCEPT, with the macro only going up until the last row of A and no further.
I have:
Sub FillCellsFromAbove()
' Turn off screen updating to improve performance
Application.ScreenUpdating = False
On Error Resume Next
' Look in column A
With Columns(3)
' For blank cells, set them to equal the cell above
.SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C"
'Convert the formula to a value
.Value = .Value
End With
Err.Clear
Application.ScreenUpdating = True
End Sub
It however fills right from the bottom of the page and not from where the last "A" value is.
Don't use all of Column C -- first determine how far the data in Column A extends and then grab that many cells in column C:
Sub FillCellsFromAbove()
Dim R As Range, n As Long
n = Range("A:A").Rows.Count
n = Cells(n, "A").End(xlUp).Row
Set R = Range(Cells(1, 3), Cells(n, 3))
Application.ScreenUpdating = False
On Error Resume Next
With R
' For blank cells, set them to equal the cell above
.SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C"
'Convert the formula to a value
.Value = .Value
End With
Err.Clear
Application.ScreenUpdating = True
End Sub
You might want to test for blanks before attempting to put formulas into cells that may not exist.
With Columns(3).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 1)
If CBool(Application.CountBlank(.Cells)) Then
' For blank cells, set them to equal the cell above
.Cells.SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C"
'Convert the formula to a value
.Value = .Value
End If
End With
I have this code:
lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To lr
If (Sheet1.Cells(a, 1) = Date Or Date - 1) And (Sheet1.Cells(a, 2) = "AA" Or Sheet1.Cells(a, 2) = "BB" Or Sheet1.Cells(a, 2) = "CC") And Sheet1.Cells(a, 3) = array(0) Then
Call ActivateSheet
Sheet1.Range(Cells(a, 4), Cells(a, 10)).Copy
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial
End If
Next a
I have two columns with data in them. In column A we have there the value of DATE which i'll call currentDate and the value of DATE-1 which i'll call yesterDate. In column B I could have three different values, which are AA, BB, and CC. My if statement above (i apologize for how noobish the code looks, i'm still trying to learn VBA. ;P) basically checks if the values in column A are either the currentDate OR yesterDate and checks if the values in column B are either AA, BB, OR CC. THEN, if the values of column A and column B are any combinations of the given values, it will copy that range of cells and paste it on Sheet2.
So here's what I want to happen. From all the possible combinations of the values given, there's one combination I don't want to copy and that combination is yesterDate && CC.
I only want my code to copy yesterDate && AA, and yesterDate && BB, and currentDate && CC. All other combinations like currentDate && AA or currentDate && BB will not likely to happen based from the user input.
I just want to exclude yesterDate && CC to be copied by my code. Any ideas on how I can achieve this?
Here, I got one for you. Try with this.
Public Sub checkAndCopy()
Dim rowCount, row As Integer
Dim dateCell, valueCell, combinationCell As String
Dim isValid As Boolean
'Getting row count from Sheet1
rowCount = Sheet1.Cells(Rows.Count, 1).End(xlUp).row
'Looping all row from Sheet1.
For row = 1 To rowCount
'getting cell values
dateCell = Sheet1.Range("A" & row)
valueCell = Sheet1.Range("B" & row)
combinationCell = Sheet1.Range("C" & row)
'Sometime one of these cell should be blank or wrong date value.
'So, I added checking to avoid it.
'If these two cell are not empty, check date is valid or not.
If dateCell <> "" And valueCell <> "" Then
'If date value is valid, go on checking for copy cell.
If IsDate(dateCell) Then
'Reset isValid flag.
isValid = True
'You just want to exclude yesterday & CC.
'So, I only check for it.
If dateCell = Date - 1 And valueCell = "CC" Then
isValid = False
End If
'If both cell values are valid and also combination cell is valid, copy and paste cell.
If isValid And combinationCell = array(0) Then
'Select cells
Sheet1.Range(Cells(row, 4), Cells(row, 10)).Select
'Copy cells
Selection.Copy
'Paste cells
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial
'Reset clipboard
Application.CutCopyMode = False
End If
End If
End If
Next row
End Sub