Hide columns of a year - vba

I want to hide all columns of dates which years aren't the last 2 years. For that (I don't know whether it is the correct approach or not) I've been doing some research given that I know nothing about Excel programming, and I've created this VBA script but it does not seem to work:
Function OcultarFechas(Range)
Rg1 = Range ' B2:AA2
Flag = "ok"
For Each c1 In Range(Rg1).Cells
If Year(c1) <> Year(Date) Then
Columns(c1.Column).EntireColumn.Hidden = True
Else
Flag = "notok"
End If
If Flag = "notok" Then Exit For
Next c1
End Function
It would be preferable that the scripts executes when I open the spreadsheet but right now with this code I think I need to call the function on a cell like: "=OcultarFechas(B2:AA2)".
PS. the dates are ordered that's why I exit the for loop when the current year is found, and from that column I need to keep them unhidden

You cannot hide a column using UDF.
Try something like this...
Sub HideColumns()
Dim c As Long, lc As Long
lc = Cells(2, Columns.Count).End(xlToLeft).Column
Columns.Hidden = False
For c = 2 To lc
If Year(Cells(2, c)) < Year(Date) Then
Columns(c).Hidden = True
End If
Next c
End Sub
The code above will find the last column used in Row2 and loop through column 2 to the last column found and check the year condition and hide the column accordingly.
To call this procedure automatically when you open the workbook, place the following code on ThisWorkbook Module.
Private Sub Workbook_Open()
Call HideColumns
End Sub

Related

Hide Rows based on Date in Column

I've searched and searched the internet and all of the forums and I've been piecing together code and still can't figure this out. I've tried For loops and For Each loops and still can't get it right. In my sheet, I have all of my dates in Column D. I want to hide rows by month. I want to be able to click a macro button and only show dates in January, or February, or etc.
This is what I currently have:
Sub January()
'
'
'
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
End If
If cell.Value < "1/1/2018" Or cell.Value > "1/31/2018" Then
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
When I run this, it just hides anything that isn't an empty cell. I've cycled between defining cell as a Range and as a Variant and it's the same either way.
ETA:
It is working now and it took help from everybody. I really appreciate it! Here's what I ended with..
Sub January()
'
'
'
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
ElseIf cell.Value < CDate("1/1") Or cell.Value > CDate("1/31") Then
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
I removed the years from the code so that I don't have to change any coding for future years.
Your current setup would qualify all dates as either < or > the respective date comparison.
If you are trying to hide rows for January in this code, then you need to use AND instead of OR
And be sure you use >= & <= to include those first and last dates.
If cell >= "1/1/2018" AND cell <= "1/31/2018" Then
If you are trying to hide rows not January then your < and > are transposed:
If cell < "1/1/2018" OR cell > "1/31/2018" Then
Alternative approach: If you've got Excel 2013 or later, simply add a Table Slicer and filter on a MONTH column generated with =DATE(YEAR([#Date]),MONTH([#Date]),1) as shown below:
Or otherwise use a PivotTable and a Slicer:
To see how easy it is to set up a PivotTable, see VBA to copy data if multiple criteria are met
Ultimately, I believe this is the code you're looking for:
Sub January()
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In Range("Date")
'If date falls on or after January 1, AND on or before January 31, don't hide the row
If cell.Value >= CDate("1/1/2018") And cell.Value <= CDate("1/31/2018") Then
cell.EntireRow.Hidden = False
Else
'If the cell doesn't contain anything or isn't in January, hide the row
cell.EntireRow.Hidden = True
End If
Next cell
Application.ScreenUpdating = True
End Sub
You need to use And logic, not Or logic. Or logic always returns TRUE unless both expressions are false or there is a null involved. Because of this, the code stopped looking at your logical statement once it evaluated to true since every date you had - I'm assuming - fell after January 1, 2018. This in turn caused the rows to hide unexpectedly.
Additionally, I would convert the strings you have into dates using CDate. It helps Excel understand what is going on a bit better and makes your code easier to understand to outsiders. Another good practice to work on is adding comments to code. I think we've all learned the hard way by leaving comments out of code at some point or another.
One last thing: if you're planning to have buttons for each month, consider doing one procedure for all of them and having variables populate the date ranges, potentially using input boxes to get the values from the user. It'll save you a lot of headaches if you ever decide to change things up in the future.
Untested, written on mobile. I am just providing an alternative approach which tries to use MONTH and YEAR. Some may find this approach easier to understand.
Option Explicit
Sub January()
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
Else
cell.EntireRow.Hidden = (Month(cell.Value) = 1) and (year(cell.Value) = 2018)
End if
Next cell
End sub
I will actually go with Slicers and Table.
But if you call VBA your neat solution then I'd say abandon the loop.
Have nothing against it but if Excel already have the functionality, then use it.
It is like a discount or a promotion that we need to take advantage of.
So instead of loop, why not just filter?
Dim lr As Long, r As Range
With Sheet1 '/* sheet where data reside */
.AutoFilterMode = False '/* reset any filtering already applied */
lr = .Range("D" & .Rows.Count).End(xlUp).Row '/* get the target cells */
Set r = .Range("D1:D" & lr) '/* explicitly set target object */
'/* filter without showing the dropdown, see the last argument set to false */
r.AutoFilter 1, ">=2/1/2018", xlAnd, "<=2/28/2018", False
End With
Above is for February of this year, you can tweak it to be dynamic.
You can create separate sub procedure for each month of you can just have a generic one.

Finding and deleting dates in column vba

I am trying to create a function that will scan through a column and delete (or replace with nothing) any date of any form. 8/24 or 8/24/16. I have been unable to find an efficient way of doing this.
Check below code. Guess this will do
Sub Change_Dtfld2Blank()
cllRange = 100 ''SpecifyNo of rows in question
clNum = 1 '''Specify Colum Number
sSheetname = "Sheet2" ''Specify Sheet name
For i = 1 To cllRange
If IsDate(Sheets(sSheetname).Cells(i, clNum).Value) Then
Sheets(sSheetname).Cells(i, clNum) = ""
End If
Next i
End Sub

Excel VBA - how to populate a range with COUNTIF values that reference non-consecutive columns

Disclaimer: I realize that this is easy to solve by just forumlating the TALLY column within the table, but this is more of an exercise in learning VBA in general.
I have table in my worksheet that has multiple columns of "Yes" or No", and I would like to find a way in VBA to tally the No's in a separate column. Here is an example of what I am trying to describe:
I figure it involves a loop somehow which would include Application.WorksheetFunction.CountIf, but short of doing a really messy Union range to reference I cannot figure how to code this effectively. Thank you in advance for any ideas posited.
Something like formula:
=COUNTIF(C:C,K1)+COUNTIF(F:F,K1)+COUNTIF(I:I,K1)
where K1 contains the value in C:C, F:F, and I:I that you want to count.
now if you need to count in ANY column you could just set the all the columns and do countif()
such as =COUNTIF(A:I,K1) but any occurrence within A:I will be counted if Yes/No.
also note this is case insensitive.
I'd do it like this (NOT with Countif):
Sub countCond()
Dim cond As String
Dim i As Long
Dim countCond As Long
Dim column As Variant
cond = "No" 'You can set this to 'Yes' as well
With Sheet1 'Or Worksheets("Sheet1") 'or whatever you have
For i = 1 To .Range("TALLY").Cells.Count
'I suggest naming it (at least the sum column)
'--Edit: Without the header, so just the values.
For Each column In .UsedRange.Columns
'Or maybe instead UsedRange, name the section
'that contains these columns
If column.Cells(1).Value Like "*COMP" Then 'Assuming this is true
If column.Cells(i + 1) = cond Then countCond = countCond + 1
End If
Next
.Range("TALLY").Cells(i, 1).Value = countCond
countCond = 0
Next i
End With
End Sub
This way, your code manually counts the cond variable in every row for every column that looks like *COMP.
Hope it helps.
Thank you all for your input, I believe I found an answer to my problem. Using this code I was able to get the results I wanted:
Sub Test()
Dim Fx() As Variant
Dim i As Integer
Dim tg_row As Integer
Fx() = Array("Table1", "[EXAComp]", "[EXBComp]", "[EXCComp]")
For Each cl In Range("Table1[TALLY]")
For i = 1 To 3
If Range(Fx(0) & Fx(i)).Cells(tg_row, 1).Value = "No" Then
cl.Value = cl.Value + 1
Else: cl.Value = cl.Value + 0
End If
Next
tg_row = tg_row + 1
Next cl
End Sub

Excel 2010 VBA to copy tab names to consecutive columns

I am trying to build quite a complex excel macro based on dynamic data. My first stumbling block is that i am struggling to get a button-triggered Excel macro to take name of each tab after the current one and insert its name every third column of the current sheet
I have:
Sub Macro1()
On Error Resume Next
For Each s In ActiveWorkbook.Worksheets
Sheet2.Range("A1:ZZ1").Value = s.Name
Next s
End Sub
This really does not work well, as it simply seems to enter the name of the last sheet all the way between A1 and ZZ1! what am I doing wrong?
This will put the names of worksheets in the tabs to the right of the Activesheet in every 3rd column of row 1 of the Activeshseet:
Sub Macro1()
Dim i As Long
With ThisWorkbook
'exit if Activesheet is the last tab
If .ActiveSheet.Index + 1 > .Worksheets.Count Then
Exit Sub
End If
For i = .ActiveSheet.Index + 1 To .Worksheets.Count
.ActiveSheet.Cells(1, (i - .ActiveSheet.Index) + (((i - .ActiveSheet.Index) - 1) * 2)) = .Worksheets(i).Name
Next i
End With
End Sub
Please note that it's a bad idea to useOn Error Resume Next in the general manner that you did in your original code. It can mistakenly mask other errors that you don't expect. It should just be used to catch errors that you do expect.

Collect numbers from a column containing empty cells using Excel VBA

I have a little problem, I occasionally bump into this kind of problem, but I haven’t found a fast solution so far.
So, imagine we have an Excel worksheet and let's suppose that we have a couple of numbers in column ’A’ with some empty cells in it. Altogether (just to make it simple) we have the first 10 cells in column 'A' to observe. For example:
3
(empty cell)
(empty cell)
6
(empty cell)
4
(empty cell)
23
(empty cell)
2
Now in the next step I would like to collect these numbers into another column (for example, column ’B’) using VBA. Obviously I just want to collect those cells which contain a number and I want to ignore the empty cells. So I would like to get a column something like this:
3
6
4
23
2
I have already written the following code, but I’m stuck at this point.
Sub collect()
For i = 1 To 10
if cells(i,1)<>"" then...
Next i
End Sub
Is there an easy way to solve this problem?
Probably the quickest and easiest way is to use Excel's Advanced Filter - the only amendment you'll need to make is it add a field name and criteria. You can even list unique items only:
The VBA equivalent is
Sub test()
With Sheet1
.Range("B1:B8").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
"D1:D2"), CopyToRange:=.Range("F1"), Unique:=False
End With
End Sub
You should be able to use the method in the post int the comments, but you could also use SpecialCells like Range("A:A").SpecialCells(xlCellTypeConstants,xlNumbers).Copy to get all of the filled cells.
Edit: needed constants not formulas.
This will work for any number of rows that you select. It will always output in the next column at the start of your selection e.g. if data starts in B10 it will ooutput in C10
Sub RemoveBlanks()
Dim cl As Range, cnt As Long
cnt = 0
For Each cl In Selection
If Not cl = vbNullString Then
Cells(Selection.Cells(1, 1).Row, Selection.Cells(1, 1).Column).Offset(cnt, 1) = cl
cnt = cnt + 1
End If
Next cl
End Sub
If you wish to loop manually and don't mind specifying the maximum row limit;
Dim i As long, values As long
For i = 1 To 10
If cells(i, 1).Value <> "" Then
values = (values + 1)
' // Adjacent column target
cells(values, 2).value = cells(i, 1).value
End If
Next i