Skip to content

Instantly share code, notes, and snippets.

@danwagnerco
Last active September 6, 2015 11:50
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save danwagnerco/72315d6aebcd123b7c64 to your computer and use it in GitHub Desktop.
Save danwagnerco/72315d6aebcd123b7c64 to your computer and use it in GitHub Desktop.
This script moves data on the 'Allocate' sheet to a dynamic destination sheet based on user input
Option Explicit
Public Sub MoveDataBasedOnDropDown()
Dim strInput As String, strPromptMessage As String
Dim wksAllocate As Worksheet, wksTarget As Worksheet
Dim obj As Object
Dim lngAllocateLastRow As Long, lngAllocateLastCol As Long, _
lngTargetLastRow As Long
Dim rngAllocate As Range, rngTarget As Range
'Set references up-front
Set wksAllocate = ThisWorkbook.Sheets("Allocate")
'Get the month and year our user has selected
strInput = wksAllocate.Range("B2").Value
'Verify that the drop-down selection corresponds to an existing sheet
On Error Resume Next
Set obj = ThisWorkbook.Sheets(strInput)
If Err <> 0 Then
strPromptMessage = "Oops! It appears that your drop-down " & _
"selection does not correspond to a " & _
"sheet that exists! Create a worksheet " & _
"named '" & strInput & "' and try again..."
MsgBox strPromptMessage
Exit Sub
End If
On Error GoTo 0
'Set the target worksheet now that the selection has been validated
Set wksTarget = ThisWorkbook.Sheets(strInput)
'Create a range representing the data we will write to the target sheet
lngAllocateLastRow = LastOccupiedRowNum(wksAllocate)
lngAllocateLastCol = LastOccupiedColNum(wksAllocate)
With wksAllocate
Set rngAllocate = .Range(.Cells(5, 2), _
.Cells(lngAllocateLastRow, lngAllocateLastCol))
End With
'Create a range representing the destination on the target sheet
lngTargetLastRow = LastOccupiedRowNum(wksTarget)
Set rngTarget = wksTarget.Cells(lngTargetLastRow + 1, 1)
'Cut the data from the Allocate sheet and paste to the target sheet
rngAllocate.Cut Destination:=rngTarget
'Let the user know their input has been allocated!
MsgBox "Success! Data moved to " & strInput & "!"
End Sub
'This function determines the last-occupied row for the passed-in Sheet
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
LastOccupiedRowNum = .Cells.Find(What:="*", _
After:=.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End With
Else
LastOccupiedRowNum = 1
End If
End Function
'This function determines the last-occupied column for the passed-in Sheet
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
LastOccupiedColNum = .Cells.Find(What:="*", _
After:=.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious _
).Column
End With
Else
LastOccupiedColNum = 1
End If
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment