I have an excel workbook created by an executable with data for days of the month on separate worksheets. 'Sheet 1' of the executable also has the days of the month listed. I would like to write a macro that will show/hide the worksheets based on the date in 'Sheet 1'.
For Instance, if the data for the month of Jan has days 1,2,3,4,5,11,12 displayed then the macro should show only the corresponding worksheets for Day1, Day2, Day3, Day4,Day5 and hide Day6 through Day10 and show Day11 and Day12. Any pointers are appreciated.
Thank you.
public sub setSheetVisiblity()
'Load the data from sheet 1 into a collection
'I'm making the assumption that you just have days listed horizontally from
'1A to 1*
Dim currentColumn as Integer
Dim activeDayCollection as Collection
currentColumn = 1
Set activeDayCollection = new Collection
While Cells(currentColumn, 1).Value <> ""
activeDayCollection.add Cells(currentColumn, 1).Value
currentColumn = currentColumn + 1
Wend
'Make every sheet invisible/visible
For each currentWorksheet as Worksheet in Worksheets
If currentWorksheet.Name == "Day" + activeDayCollection.Item 1 Then
currentWorksheet.Visible = true
activeDayCollection.Remove 1
Else
currentWorksheet.Visible = false
End If
Next currentWorksheet
end sub
The code works off of the assumption that the days in your first sheet are in increasing order, the sheets are named Day###, where ### is the day number, and you will probably have to add another line to manually unhide your first sheet. I don't have vba with me so this code might have some syntax errors, but it should get you going in the right direction.
Related
I have a requirement that once a week on a Friday I need to pull some data from workbooks generated each day of the week (Mon-Fri) into a weekly dated summary in a new workbook. The new workbook is to be a cumulative view of each week with the date auto populated on the Friday when the data is pasted into the summary sheet.
I need some pointers on how to logically work out the current date, search back to find the first file from that Monday (but include Friday's file) and then to insert the range of dates from that week into the corresponding cells next to the copied data.
I've found various posts from others looking to do a similar thing, and I've attempted to begin working on that basis to produce what I want it to do. However, I'm not trained in VBA so I am attempting everything on a 'best efforts' basis. The below is the code I have written which currently just opens up the last file in the directory. I also have a separate tab with the public holidays I want it to take into account when running the macro. Clearly there's a lot for me to do, I would be grateful for any tips and pointers on what I should try.
Sub WeeklyUpdate()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim LastPreviousWorkday As Date
'date format to use and where to lookup the bank holidays
LastPreviousWorkday = Application.WorksheetFunction.WorkDay(Date, -1)
LastPreviousWorkday = Format$(LastPreviousWorkday, ("yyyy-mm-dd"))
LastPreviousWorkday = Application.WorksheetFunction.WorkDay(Date, -1, Worksheets("PublicHolidays").Range("A:A"))
'This is where I want it to opens the last 5 days of workbooks from today's date including today e.g. Monday-Friday, report is always run on a Friday
Workbooks.Open "W:\Inventory\Inventory Support\3. Reporting\Daily\Daily Fails Report\Daily Fails Report " & Format(Date, "yyyy-mm-dd") & ".xlsb"
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("Daily Fails Report 2019-06-26.xlsb").Worksheets("Daily Fails Report (National)")
Set wsDest = Workbooks("Weekly Issues Summary.xlsb").Worksheets("CurrentPeriodSummary")
'Find last used row in the copy range based on data in column O
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "O").End(xlUp).Row
'Find first blank row in the destination range based on data in column B
'Offset property moves down 1 row to exclude headers
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
'Copy data range excluding the grand total which is always the last row (so use -1 to select the last row above it) & Paste Data into Summary
wsCopy.Range("O9:Q" & lCopyLastRow - 1).Copy _
wsDest.Range("B" & lDestLastRow)
End Sub
I expect the output of the above to update my summary workbook with five lines of data per week with a date against each one that corresponds to the date in the name of the file.
I need some pointers on how to logically work out the current date, search back to find the first file from that Monday (but include Friday's file) and then to insert the range of dates from that week into the corresponding cells next to the copied data.
The following function outputs the date range (as an array), from Today going back to the previous Monday.
Option Explicit
Function dateStuff() As Date()
Dim lastMonday As Date
Dim arrDates() As Date
Dim I As Long
lastMonday = Date - Weekday(Date, vbMonday) + 1
ReDim arrDates(0 To Date - lastMonday)
For I = 0 To UBound(arrDates)
arrDates(I) = lastMonday + I
Next I
dateStuff = arrDates
End Function
You can then use the output of this function to create the names for the corresponding workbooks.
If I understand what you are doing correctly, there shouldn't be a need to exclude holidays from this list. Since you won't have a workbook generated for a holiday, just test to see if the workbook exists when you are trying to obtain the data.
Here's a routine to put the generated date range into some cell. You can work out how to change rOutput to reflect your real target cell. This Sub depends on the above Function:
Sub insertDateRange()
Dim dateRange() As Date
Dim rOutput As Range
Set rOutput = Worksheets("sheet1").Range("B1")
dateRange = dateStuff
rOutput = dateRange(0) & " - " & dateRange(UBound(dateRange))
End Sub
Run Today 27-Jun-2019 the macro will output 6/24/2019 - 6/27/2019
but you can use the VBA Format function to change the output format of the dates if you desire.
EDIT:
So far as opening the workbooks and processing them, it's just a matter of iterating through the output of the dateStuff function to generate your workbook paths. eg:
'This is where I want it to opens the last 5 days of workbooks from today's date including today e.g. Monday-Friday, report is always run on a Friday
Dim wbDates() As Date, Idx As Long
Dim wbDaily As Workbook, wbPath As String
wbDates = dateStuff 'wbDates now contains an array of the relevant dates
'This will open the workbooks one at a time and you can process them as you wish
'You should refer to this daily workbook as `wbDaily` or some other variable of your choice
For Idx = LBound(wbDates) To UBound(wbDates)
wbPath = "W:\Inventory\Inventory Support\3. Reporting\Daily\Daily Fails Report\Daily Fails Report " & Format(wbDates(Idx), "yyyy-mm-dd") & ".xlsb"
If Len(Dir(wbPath)) > 0 Then 'workbook exists
Set wbDaily = Workbooks.Open(wbPath)
'your code
'.....
wbDaily.Close
End If
Next Idx
I'm trying to help a colleague out with their spreadsheets (on MAC Excel V16.16.8), since I have some experience with coding, mostly in SQL, only very very basic level of VBA.
They receive daily data (which is why VBA is needed) which I have managed to split into separate sheets for them using basic macros.
The name of the sheet is "Birmingham" in this example.
Column B "Interval" are the hours of the day (24 hour clock). They only receive any data for the hours of the day where data actually exists in other columns. However, for their reports, they need to add/insert new rows even where there isn't any data from 0-23 (midnight-11pm).
The "Interval" column needs the correct hour/number in this descending order as seen in the example, with the Date and Campaign columns just being the same throughout. And have the rest of the cells for Total_Calls, Closed, etc, containing "0"s.
How do I add the new rows, "Intervals", and the "0"s?
I have tried a couple of different ways mostly around attempting to merge a mostly blank separate table only containing all of the "Intervals" 0-23. However, I have failed miserably in each method.
I am almost 100% sure there is a relatively simple method of doing this, but I lack specific VBA knowledge.
Any help would be most appreciated.
Thanks
You can get the current date and current campaign and insert missing rows like this:
Private Sub FillAllHours()
Dim i As Long
Dim myDate As Date ' value from date column
Dim myCampain As String ' value from campaign column
With ActiveSheet
myDate = .Cells(.Rows.Count, 1).End(xlUp).Value
myCampain = .Cells(.Rows.Count, 3).End(xlUp).Value
For i = 2 To 25
If .Cells(i, "B") <> i - 2 Then ' if row is missing
.Rows(i).Insert ' insert row above
.Cells(i, "B") = i - 2 ' insert hour number
.Cells(i, "A") = myDate ' insert date
.Cells(i, "C") = mycampaign ' insert campaign
.Cells(i, "D").Resize(1, 9).Value = 0 ' fill 9 cells with 0
End If
Next i
End With
End Sub
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
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
This is my first post. I am currently working on a project at work which requires that I work with several different worksheets in order to create one mail master worksheet, as it were, in order to do a mail merge. The worksheet contains information regarding different purchases, and each purchaser is identified with their own ID number. Below is an example of what my spreadsheet looks like now (however I do have more columns):
ID Salutation Address ID Name Donation ID Name Tickets
9 Mr. John Doe 123 12 Ms. Jane Smith 100.00 12 Ms.Jane Smith 300.00
12 Ms. Jane Smith 456 22 Mr. Mike Man 500.00 84 Ms. Jo Smith 300.00
What I would like to do is somehow sort my data so that everythign with the same unique identifier (ID) lines up on the same row. For example ID 12 Jane Smith - all the information for her will show up under her name matched by her ID number, and ID 22 will match up with 22 etc...
When I merged all of my spreadsheets together, I sorted them all by ID number, however my problem is, not everyone who made a donation bought a ticket or some people just bought tickets and nothing us, so sorting doesn't work.
Hopefully this makes sense.
Thanks in advance.
You can do this in Excel VBA. If you haven't used VBA in Excel before, see the link below to see how to access it.
http://msdn.microsoft.com/en-us/library/ee814737.aspx
Make sure you backup your spreadsheet before trying any of this in case something goes wrong!
I wrote something up that will copy data from your secondary worksheets into your main worksheet. Just open the VBA editor, and paste in the code.
Next, edit the ConsolidateWorksheets() function so that it has the right names for your sheets. If you have additional sheets, declare them and add another line that calls the ProcessWorksheet subroutine for the added sheet.
This code will copy data from your tickets and donations worksheet into your main worksheet when it finds a matching id. If there isn't a matching id, it doesn't copy anything for that row.
Option Explicit
Sub ConsolidateWorksheets()
'declare the worksheets you are using
Dim mainWks As Worksheet
Dim ticketsWks As Worksheet
Dim donationsWks As Worksheet
'set the worksheet names
Set mainWks = ThisWorkbook.Worksheets("Sheet1")
Set ticketsWks = ThisWorkbook.Worksheets("Sheet2")
Set donationsWks = ThisWorkbook.Worksheets("Sheet3")
Call ProcessWorksheet(mainWks, ticketsWks)
Call ProcessWorksheet(mainWks, donationsWks)
End Sub
' copies data from the otherWks to the mainWks
Sub ProcessWorksheet(mainWks As Worksheet, otherWks As Worksheet)
Dim i As Integer
Dim rowId As Integer
Dim otherRowIndex As Integer
Dim otherLastColIndex As Integer
Dim lastRowIndex As Integer
Dim pasteColStart As Integer
Dim pasteColEnd As Integer
' figure out the last row in the main sheet
lastRowIndex = mainWks.UsedRange.Rows.count
otherLastColIndex = otherWks.UsedRange.Columns.count
' figure out where to copy and paste from
' this assumes that the id row is always the first row in every sheet
pasteColStart = mainWks.UsedRange.Columns.count + 1
pasteColEnd = pasteColStart + (otherLastColIndex - 2)
' copy column headers
otherWks.Activate
otherWks.Range(Cells(1, 2), Cells(1, otherLastColIndex)).Copy
mainWks.Activate
mainWks.Range(Cells(1, pasteColStart), Cells(1, pasteColEnd)).PasteSpecial
' loop through all the rows of the main sheet
For i = 2 To lastRowIndex
' get row id from first cell in current row
rowId = Cells(i, 1).Value
'lookup row id in other worksheets
otherRowIndex = FindIdRowInWks(otherWks, rowId)
If otherRowIndex <> 0 Then
otherWks.Activate
otherWks.Range(Cells(otherRowIndex, 2), Cells(otherRowIndex, otherLastColIndex)).Copy
mainWks.Activate
mainWks.Range(Cells(i, pasteColStart), Cells(i, pasteColEnd)).PasteSpecial
End If
Next i
End Sub
' loops through the given worksheet, looks for a given id in the first column
' and returns the row index where the id was found. returns 0 if nothing found.
Public Function FindIdRowInWks(wks As Worksheet, idToFind As Integer) As Integer
Dim lastRow As Integer
lastRow = wks.Range("A" & Rows.count).End(xlUp).Row
Dim rowNumber As Integer
rowNumber = 0
Dim i As Integer
For i = 2 To lastRow
If (Cells(i, 1).Value = idToFind) Then
rowNumber = i
End If
Next i
FindIdRowInWks = rowNumber
End Function
Hope that helps!
You can do this in 3 Steps without VBA:
1) Create new worksheet
2) On New Sheet get a consolidated list of ID & Salutation
For XL2007 see Remove Duplicates, for XL2003 see advanced filter.
3) Create a Setup Like so using vlookups and iferror to grab the values you want based on the relevant sections from the original sheet. See the image and the vlookup formula in the formula bar