This script moves data on the 'Allocate' sheet to a dynamic destination sheet based on user input
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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