I have made a calendar with the dates throughout the year which I will use to register new objects every month. The month itself isn't important - I just am using month as a reference to find the correct range of dates so at the moment looks.
FEB 01/02/2014
FEB 02/02/2014
FEB 03/02/2014
FEB 04/02/2014
FEB 05/02/2014
MAR 01/03/2014
MAR 02/03/2014
JUN 02/06/2014
Jun 03/06/2014
The whole year is in place. I have a drop down menu on the first page detailing the month, I would like a macro that uses the month selected as a reference and then copies all the dates associated with that month to a separate column.
Any ideas?
The following code should be close - adapt as needed. It was not written for efficiency - unless you have many thousands of items to copy, this will take "no time at all". The Application.ScreenUpdating trick stops the screen from flickering (and makes it faster) during the update.
Option Compare Text
Sub moveStuff()
Dim rLabel As Range
Dim rLabelSource As Range
Dim rDestination As Range
Dim c, L
' first label:
Set rLabel = ActiveWorkbook.Worksheets("source").Range("A2")
' extend all the way down:
Set rLabel = Range(rLabel, rLabel.End(xlDown))
Set rLabelSource = ActiveWorkbook.Worksheets("destination").Range("A1")
Set rLabelSource = Range(rLabelSource, rLabelSource.End(xlToRight))
Application.ScreenUpdating = false
' labels in the top row:
For Each L In rLabelSource.Cells
' write results in the next row down:
Set rDestination = L.Offset(1, 0)
For Each c In rLabel.Cells
If c.Value = L.Value Then
rDestination.Value = c.Offset(0, 1).Value
Set rDestination = rDestination.Offset(1, 0)
End If
Next c
Next L
Application.ScreenUpdating = true
End Sub
In this case, dates and labels are in the sheet called "source":
And the destination sheet (with labels in the top row, and copied dates appearing below them) in sheet called "destination":
Obviously there are many ways to make this cleaner (clear all the space below the labels in destination before copying, so no old values are left behind, for example). And in "real" code you would add error handling, etc.
This should get you going though.
Related
I apologize for the poor question name, if anybody has better suggestions at the end of this, let me know.
I have a range, say A1:M4 with the months in row 1 and a total for each row in column M. For each cell, there are values except for the months that have not yet happened. So if in November, everything up to November is filled in and December, column L, is empty and column M has the total from Jan to Nov (col A to col L). Another example, if in May, Jan, Feb, March, April and May and filled in, but not the other months, and column M has the total.
I want to create code that copies all the values up to the current month including the total for each row and paste into a powerpoint (I know how to copy and paste into a ppt). How do I copy this?
Current code:
rng=Range("a1",Range("a1").End(xldown).End(xlright))
Copies the entire range. How do I delete the columns without values in it. I thought of creating a count to count the values from column A to L, but having trouble incorporating how to remove the difference between total columns and filled in columns
This procedure can help you to find empty columns.
Sub FindBlankColumns()
'Step1: Declare your variables.
Dim MyRange As Range
Dim iCounter As Long
'Step 2: Define the target Range. Change to fit your needs
Set MyRange = ActiveSheet.UsedRange
'Step 3: Start reverse looping through the range.
'You can modify this according to your needs.
For iCounter = MyRange.Columns.Count To 1 Step -1
'Step 4: If entire column is empty then do some stuff.
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
' Insert your code here to do what you want with empty column.
End If
Next
End Sub
1) I have a column of data which fills a multiselect listbox in a userform. Values are the days of the week "Monday" - "Sunday"
Dim ListsSheet As Worksheet
Dim LastRow As Long
Dim aCell As Range
Set ListsSheet = Sheets("Lists")
With ListsSheet
'Fills Days
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Each aCell In .Range("A2:A" & LastRow)
If aCell.value <> "" Then
Me.Day.AddItem aCell.value
End If
Next
2) I'm able to gather the multi-selected values and transfer it to a worksheet for manipulation. Assuming the user selected days "Tuesday" + "Wednesday", my data in the cells = "Tuesday, Wednesday"
3) I'm attempting to recreate the listbox as it was originally selected by a user. I am able to use .additem to generate the list of days again, but I'm unsure how to go about selecting the correct .listindex value based on the initial selection
The selection you make in a listbox are recorded in a zero-based boolean array which has as many elements as the listbox has items. This array is accessible by the listbox's Read/Write Selected property. In your case ListBox1.Selected(0) refers to "Monday" and ListBox1.Selected(6) to Sunday.
ListBox1.Selected(0) will be True or False depending upon whether Monday is selected or not. You can read this property when you close the form and re-establish the same setting by setting ListBox1.Selected(0) = True (or False) when you show the form again.
Since you have the weekday names in A2:A8 you might write the Selected() array into B2:B8 in real time using the ListBox1_Change event, and use this range both on your sheet and to reset the ListBox.
By the way, your way of setting the list isn't the most efficient. For one, you always want 7 items in your list. Therefore
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
will cause more mistakes than it prevents. For another, Excel's VBA has provided the Rowsource property. You can set the list by setting that property. Both the following examples are correct.
ListBox1.RowSource = ActiveSheet.Range("A2:A8").Address
ListBox1.RowSource = "DaysList" ' where DaysList is a named range
The use of ActiveSheet is safe if you call the form from a worksheet and therefore know which one will be active at the time. Or you can apply an array directly to the List property, like this:-
ListBox1.List = Split("Mon Tue Wed Thu Fri Sat Sun", " ")
Iv'e been breaking my head over this.
My first sheet contains these buttons:
ImageButtons
With this being the transportFile:
transportFile
So I'm trying to make it so that just the rows that contain (in this case) January and february dates get pasted to the "2016" sheet.
This is the code that I'm using right now:
If CheckBoxJanuary.Value = True Then
Worksheets("2016").Range(Worksheets("2016").Cells(2, 1), Worksheets("2016").Cells(janCount, 13)).Value = Worksheets("transportFile").Range(Worksheets("transportFile").Cells(2, 1), Worksheets("transportFile").Cells(janCount, 13)).Value
End If
If CheckBoxFebruary.Value = True Then
Worksheets("2016").Range(Worksheets("2016").Cells(janCount + 1, 1), Worksheets("2016").Cells(janCount + febCount, 13)).Value = Worksheets("transportFile").Range(Worksheets("transportFile").Cells(janCount + 1, 1), Worksheets("transportFile").Cells(janCount + febCount, 13)).Value
End If
"janCount" and "febrCount" represent the numbers of rows that contain January and february dates. This is being calculated in the transportFile with
"=SUMPRODUCT(--(MONTH($A$2:$A$150)=1))"
and
"=SUMPRODUCT(--(MONTH($A$2:$A$1500)=2))"
Afterwards, I run a loop that deletes the empty rows in the 2016 sheet.
Now I have 2 questions:
In the sumproduct formula of January I had to reduce the range because excel counts every empty cell as a January one. It's almost October, so that's not a problem now. But in 2017, when there's no data yet, there will be 150 January dates. How can I solve that?
If someone (by mistake) puts a March in between the Februaries, my ranges get all messed up. How can I avoid this?
If your column with dates is formatted properly as date, then why don't check for value of month(cell)?
You could do check for each combobox while looping through all cells in column A
like
If combo box "January" selected Then
'month = 1 and non empty
If (Month(Cells(i, 1).Value) = 1) And (Cells(i, 1) <> "") Then
'copy your rows to new sheet
End if
End if
If combo box "Feb" selected Then
'month = 2 and non empty
....
As for 1. " excel counts every empty cell as a January one" probably they can be excluded somehow, a crude way would be to do exact same sumproduct for all empty cells in a column and subtract them :)
=SUMPRODUCT(--(MONTH($A$2:$A$150)=1))-SUMPRODUCT(--(($A$2:$A$150)=""))
EDIT
Ok I had to check the sumproduct, correct way is to use second array to check for cells that are non empty:
=SUMPRODUCT(--(MONTH($A$2:$A$37)=1);--(($A$2:$A$37)<>""))
This will return count of cells that have month(cell)=1 AND cell.value <> empty so you don't get false count for January when empty cell returns month=1
As for 2 if you would make the loop using VBA to go through all your data then it doesn't matter if they are in order or not as each cell month value will be read, irrespectively of order.
EDIT 2
I will not propose the solution for this option but maybe the Pivot table could be the good solution for that task? VBA code could be use to modify displayed data in the pivot table depending on the selected checkboxes.
This code will look at each checkbox on the sheet to decide which has been ticket (assuming the only checkboxes you have are for months and they're all named CheckBoxMMMMM).
It then filters by those months and copies the filtered rows to the final sheet.
Sub CopyFiltered()
Dim wrkSht As Worksheet
Dim shp As Shape
Dim FilterMonths As Collection
Dim vItem As Variant
Dim rLastCell As Range
Dim rFilterRange As Range
Dim vFilterString() As Variant
Dim x As Long
Set wrkSht = ThisWorkbook.Worksheets("TickBoxSheet")
Set FilterMonths = New Collection
'Get a collection of ticked dates.
'This works by looking at each checkbox on the sheet.
'It assumes they're all called 'CheckBoxMMMM' so it can build a real date from the name.
For Each shp In wrkSht.Shapes
If shp.Type = msoFormControl Then
If shp.FormControlType = xlCheckBox Then
If shp.ControlFormat.Value = 1 Then
FilterMonths.Add DateValue("1 " & Replace(shp.Name, "CheckBox", ""))
End If
End If
End If
Next shp
'Create an array of "1 ,<date>,1 ,<2nd date>"
x = 1
ReDim vFilterString(1 To FilterMonths.Count * 2)
For Each vItem In FilterMonths
vFilterString(x) = 1
vFilterString(x + 1) = Format(vItem, "m/d/yyyy")
x = x + 2
Next vItem
'Apply the filter - the commented line works but is hardcoded.
'The other filter line appears to be the same as the commented line, but isn't working....
With ThisWorkbook.Worksheets("2016")
If .AutoFilterMode Then .AutoFilterMode = False
Set rLastCell = Sheet2.Cells.Find(What:="*", After:=.Cells(1, 1), SearchDirection:=xlPrevious)
Set rFilterRange = .Range(.Cells(1, 1), rLastCell)
rFilterRange.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=vFilterString
'Copy the visible filtered cells to the transportfile sheet.
.Range(.Cells(1, 1), rLastCell).SpecialCells(xlVisible).Copy Destination:=ThisWorkbook.Worksheets("transportfile").Range("A1")
End With
End Sub
From what I can find on the internet the numerical value given to the array (1) returns all values in that month. Other values available are:
0 year
1 month
2 day
3 hour
4 minute
5 second
So, right now I have this excel sheet where there is a last revision date. I have named this column "LastRevisionDate". And then I have a column named "RevisionFrequency" . The "RevisionFrequency" contains a drop-down menu consisting of terms, "Annually", "Bi-Annually"(2 times in a year), "Semi-Annually", and "Quarterly". And then I have a column where it states the "NextRevisionDate". So I want to create a VBA code that would calculate the NextRevisionDate from the LastRevisionDate and the RevisionFrequency.
For example. Say in column "A" i have the RevisionFrequency to be "Bi-annually" And the last revision date was Mar-14 in column "B", then I would want the NextRevisionDate in column "C" to state Mar,Sep .Thats basically saying that the item gets revised twice a year. So I would want to create a macro where Column "C" is based off the RevisionFrequency and LastRevisionDate. I realize I could do this with a formula, but I have new items being added constantly so I do not want to keep copying formulas into each cell. Also for some items, they do not need revision, I would also like to have a blank cell if there is no LastRevisionDate.
So far, I have this updated code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = Sheets(1)
If Not Intersect(Target, ws.Range("LastCalDate").Value) Is Nothing Then
Dim Lastdate As Date
Dim DueDate As Variant
Dim Frequency As String
Dim R As Variant
Dim C As Variant
Dim R1 As Variant
Dim C1 As Variant
Dim R2 As Variant
Dim C2 As Variant
R = Range("LastCalDate").Row
C = Range("LastCalDate").Column
R1 = Range("CalDueDate").Row
C1 = Range("CalDueDate").Column
R2 = Range("CalFrequency").Row
C2 = Range("CalFrequency").Column
Lastdate = Cells(R, C).Value 'Last Cal Date
DueDate = Cells(R1, C1).Value 'Cal Due Date
Frequency = Cells(R2, C2)
If Frequency = "Annually" Then
DueDate = DateAdd("mmm", 12, Lastdate)
End If
If Frequency = "Semi-Annually" Then
DueDate = DateAdd("mmm", 6, Lastdate)
End If
If Frequency = "Quarterly" Then
DueDate = DateAdd("mmm", 3, Lastdate)
End If
End Sub
“Am I just overcomplicating my code?”
That is the wrong question. The first question is not “What can I do?” but “What do my users want?”
If you start by saying “I can produce wooden clogs”, you may never learn they want soft slippers. You may not be able to produce soft slippers but you can probably produce something a lot better than wooden clogs if know it is required. Start with the design of the ideal product then cut it down to what is practical.
From your description, I visualise something like this:
You may have many other columns and these three columns may be in different positions; it does not matter, we will restrict ourselves these columns for now.
It sounds to me as though you have two requirements and an issue:
You have a worksheet where the values in the Next Revision Date column may be unreliable or missing. You require a macro that will run down the existing worksheet and enter correct values into the Next Revision Date column.
You have a requirement to set the values in the Next Revision Date column automatically as new rows are added of existing Revision Frequencies and Last Revision Dates are amended. This could be achieved by running macro 1 or using the Worksheet Change event, as you suggest. There may be other approaches but I will not address this requirement.
If you look at the last three rows of my example worksheet, you will notice the day of the month in the Next Revision Date column is not the same as that in the Last Revision Date. This is because I converted the value in the Frequency column to 3, 6 or 12 and added that number of months to the Last Revision Date. In the last three rows the new month does not have as many days as the old and the VBA function has, for example, converted 30 February to 2 March. Is this the effect you require? I have included code to bring the date back to the “correct” month. Often the most difficult task in macro design is identifying all these exceptions and specifying how they are to be handled.
I will only consider macro 1 first since you can use it for both requirements while you are design and implementing macro 2. If you run into problems with macro 2, ask a new question. You can ask as many questions as you like – providing they are good questions – but they should only be one issue per question.
You need a macro that will step down every row of the worksheet. If you are using an online tutorial or you have bought a book on Excel VBA, you may find a suitable example there. If you are using neither an online tutorial nor a book, please start. It will not take long to master the basics of Excel VBA and the time spent learning the basics will quickly repay itself. Trying to search the web for code when you do not know the basics is very difficult.
If your tutorial/book does not tell you how to step down every row of the worksheet, try searching SO for “[excel-vba] find last row of worksheet”. There are lots of variations of this question so you should have no difficulty in finding something suitable. You do not have to do so on this occasion because I show you how below but I believe this is the best way of using this site. Break your requirement down into little steps and then search for a question relevant to each step.
Below is a simple macro 1. Study my code and come back with questions if necessary. However, the more you can understand on your own, the faster you will develop.
Welcome to the joys of programming.
Option Explicit
' Using constants for values that may change makes your code easier to
' understand and easier to maintain.
Const ColFrequency As Long = 1
Const ColLastRevisionDate As Long = 2
Const ColNextRevisionDate As Long = 3
Const RowDataFirst As Long = 2
Sub FixNextRevisionDate()
Dim DateLastCrnt As Date
Dim DateNextCrnt As Date
Dim NumMonthsToStep As Long
Dim RowCrnt As Long
Dim RowLast As Long
' Replace "Data" with the name of your worksheet
With Worksheets("Data")
' This is the most popular method of finding the last row but it will
' not work in every situation. I believe it is appropriate for your
' current requirement but suggest you look for questions that describe
' other methods and which explain why they might be better.
RowLast = .Cells(Rows.Count, ColFrequency).End(xlUp).Row
For RowCrnt = RowDataFirst To RowLast
' Convert Frequency to 3, 6 or 12
' I have used the LCase function to allow for inconsistent use of
' upper and lower case
Select Case LCase(.Cells(RowCrnt, ColFrequency).Value)
Case "annually"
NumMonthsToStep = 12
Case "bi-annually"
NumMonthsToStep = 6
Case "semi-annually"
NumMonthsToStep = 6
Case "quarterly"
NumMonthsToStep = 3
Case Else
' Unknown frequency. never assume the worksheet is correct
' if an error will cause your macro to fail.
' This is an easy way to highlight faulty values for user
' attention.
With .Cells(RowCrnt, ColFrequency)
.Interior.Color = RGB(255, 0, 0)
NumMonthsToStep = 0
End With
End Select
If NumMonthsToStep <> 0 Then
' Had valid frequency
If IsDate(.Cells(RowCrnt, ColLastRevisionDate).Value) Then
' Value in Last Revision Date column is a date
DateLastCrnt = .Cells(RowCrnt, ColLastRevisionDate).Value
' Calculate next date by adding NumMonthsToStep
DateNextCrnt = DateSerial(Year(DateLastCrnt), _
Month(DateLastCrnt) + NumMonthsToStep, _
Day(DateLastCrnt))
' You may not want this but it shows how to do it if you do
If Day(DateNextCrnt) < Day(DateLastCrnt) Then
DateNextCrnt = DateSerial(Year(DateNextCrnt), _
Month(DateNextCrnt), _
0)
End If
With .Cells(RowCrnt, ColNextRevisionDate)
.Value = DateNextCrnt
' Replace with date format of your choice
.NumberFormat = "d mmm yy"
End With
Else
' The Last Revision Date is not a date
With .Cells(RowCrnt, ColLastRevisionDate)
.Interior.Color = RGB(255, 0, 0)
End With
End If
End If
Next
End With
End Sub
I have a production workbook that has a tab for each month of the year and a YTD summary tab. Each monthly worksheet has the rows that show the different events or actions that make up a workday and the columns have the date as the header row. We do not work on Saturday or Sunday but those days appear on each of the spreadsheets. I am wanting to know how can i create a macro or VBA code to be able to automatically hide columns if the cell in that columns contains Sat or Sun. As there are multiple Saturdays and Sundays in a month it would hide multiple columns on each spreadsheet. Row 34 is the day of wek on each of the spreadsheets, utilizing a three digit day of week - Mon, Tue, Wed, etc, so i need something that says if that cell is Sat or Sun - hide that column and my columns go from B to AG. We have one of these spreadsheets for each of our over 50 workers so I could go in and manually hide them but that would take a lot of time and I know that there is a more efficient solution.
Thanks
I'm assuming you know how to set up and run VBA code as a macro? If not, see this: http://office.microsoft.com/en-us/excel-help/create-or-delete-a-macro-HP010342374.aspx#BMcreatemacrovba
Try this for the code.
Sub HideWeekends()
Dim i as integer
Dim sht as Worksheet
For each sht in ActiveWorkbook
For i = 1 to 31
If sht.Cells(34,i) = "Sat" Or "Sun" then
sht.Cells(34,1).EntireColumn.Hidden = True
End if
Next
Next
End Sub
You will have to modify this to match your spreadsheet. If the first day of the month is actually in column C instead of column A, then change
sht.Cells(34,i)
to
sht.Cells(34,i+2)
and so on.
I'm also doing this on a computer without excel, so let me know how that works and I can work with you!
Tested this based on your description above. Should work as expected.
Sub Hide_Columns_Based_On_Criteria()
Dim iCntr As Long, WS_Count As Integer, I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
ActiveWorkbook.Worksheets(I).Select
For iCntr = 2 To 33 Step 1
If Cells(34, iCntr) = "Sat" Then
Columns(iCntr).EntireColumn.Hidden = True
End If
If Cells(34, iCntr) = "Sun" Then
Columns(iCntr).EntireColumn.Hidden = True
End If
Next iCntr
Next I
End Sub
You can make adjustments to iCntr if the column range changes from B to AG
For iCntr = 2 To 33 Step 1