danwagnerco’s gists

danwagnerco / highlight_cells_based_on_selection_via_worksheet_selectionchange.vb

Created April 15, 2016 08:24

This subroutine highlights columns on a calendar in Excel based on the selected activity by leveraging the Worksheet_SelectionChange event

	Option Explicit
	Private Sub Worksheet_SelectionChange(ByVal Target As Range)

	'Set the context appropriately using With...End With
	With Sheets("calendar")

	'Clear all previously-applied highlighting for easy readability
	.Cells.Interior.ColorIndex = xlColorIndexNone

	'Switch on the address of the selected cell

Created April 8, 2016 10:39

Now that we have ClearAllFilters written, let's integrate it back into the original Subroutine!

	'This subroutine creates adds the filtered data from Sheet1
	'to a previously-existing destination Worksheet (called "Destination" here)
	Public Sub AddToDestinationWorksheet(StartDate As String, EndDate As String)

	'...
	'Lots of code taken out here for brevity, the first place we're going to replace
	'the old clear filters logic starts on line 38 of the original
	'...

	'Replaced the commented-out code with our new Subroutine, you should actually

danwagnerco / clear_all_filters.vb

Created April 8, 2016 09:45

The clear (turn off) filter functionality from our move data based on dates subroutine

	'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
	'INPUT : Sheet, the Worksheet to turn off (clear) filters on
	'DESCRIPTION : This sub clears (turns off) all filters on a Worksheet
	'SPECIAL CASE: none
	Public Sub ClearAllFilters(Sheet As Worksheet)
	Sheet.AutoFilterMode = False
	If Sheet.FilterMode = True Then
	Sheet.ShowAllData
	End If
	End Sub

danwagnerco / add_to_destination_worksheet.vb

Created April 8, 2016 09:32

This script has some repetition, making it a perfect candidate for extracting functionality... Something like 'ClearAllFilters'!

	'This subroutine creates adds the filtered data from Sheet1
	'to a previously-existing destination Worksheet (called "Destination" here)
	Public Sub AddToDestinationWorksheet(StartDate As String, EndDate As String)

	Dim wksData As Worksheet, wksTarget As Worksheet
	Dim lngLastRow As Long, lngLastCol As Long, lngDateCol As Long, _
	lngDestinationLastRow As Long, lngDestinationFirstCol As Long
	Dim rngFull As Range, rngResult As Range, rngTarget As Range
	Dim varFiltered As Variant

danwagnerco / copy_date_range_data_to_existing_worksheet.vb

Last active August 12, 2016 09:48

This macro prompts you to select a date range then copies the rows in that range to an already-existing worksheet

	Option Explicit

	'This subroutine prompts the user to select dates
	'
	'Code already written and described here:
	'http://danwagner.co/how-to-copy-data-to-a-new-workbook-based-on-dates/
	Public Sub PromptUserForInputDates()

	Dim strStart As String, strEnd As String, strPromptMessage As String

danwagnerco / copy_date_range_data_to_new_worksheet.vb

Last active March 16, 2018 21:15

This macro prompts you to select a date range then copies the rows in that range to a new worksheet

	Option Explicit

	'This subroutine prompts the user to select dates
	'
	'Code already written and described here:
	'http://danwagner.co/how-to-copy-data-to-a-new-workbook-based-on-dates/
	Public Sub PromptUserForInputDates()

	Dim strStart As String, strEnd As String, strPromptMessage As String

danwagnerco / good_enough_progress_bar.vb

Created February 23, 2016 05:41

This macro demonstrates a "progress bar" that simply updates Excel's status bar -- simple but effective as hell!

	Option Explicit
	Public Sub WriteFakeLastNames()

	Dim wksNames As Worksheet
	Dim lngLastRow As Long, lngIdx As Long
	Dim strOldName As String, strNewName As String

	'Set references up-front
	Set wksNames = ThisWorkbook.Worksheets("names")
	lngLastRow = 1001

danwagnerco / write_uniques_to_new_sheet.vb

Last active March 11, 2016 03:41

This script prompts the user to select a range, then puts all the unique values from that range into a single column list on a new worksheet

	Public Sub WriteUniquesToNewSheet()

	Dim wksUniques As Worksheet
	Dim rngUniques As Range, rngTarget As Range
	Dim strPrompt As String
	Dim varUniques As Variant
	Dim lngIdx As Long
	Dim colUniques As Collection
	Set colUniques = New Collection

danwagnerco / collect_uniques.vb

Last active August 13, 2020 16:56

This function walks through a Range and returns a Collection of the unique values

	Public Function CollectUniques(rng As Range) As Collection

	Dim varArray As Variant, var As Variant
	Dim col As Collection

	'Guard clause - if Range is nothing, return a Nothing collection
	'Guard clause - if Range is empty, return a Nothing collection
	If rng Is Nothing Or WorksheetFunction.CountA(rng) = 0 Then
	Set CollectUniques = col
	Exit Function

danwagnerco / combine_data_from_all_sheets.vb

Last active August 7, 2020 12:58

This macro combines data from many sheets into a single sheet

	Option Explicit
	Public Sub CombineDataFromAllSheets()

	Dim wksSrc As Worksheet, wksDst As Worksheet
	Dim rngSrc As Range, rngDst As Range
	Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long

	'Notes: "Src" is short for "Source", "Dst" is short for "Destination"

	'Set references up-front

Dan Wagner danwagnerco