Paste Data To Range From User Form

user_18279822 0
Viewed 38

I am looking for a little assistance with the VBA code in the workbook I have been working on. There is a userform with dependent dropdowns that pulls their values from "Master Sheet" in the workbook. The drop downs are functioning fine. However I have two roadblocks that I have now been able to get past. The first, The dropdowns allow the selection of "Category, Make, Model, and Add To". In the Master Sheet, "Category, Make, Model" Run from Columns A:C. Columns D:G have the equipment's, "Weight, Length, Width, Depth" information. I have not been able to have the information from columns A:F be copied based off the model selection. I have been trying have it paste in a test are for functionality with no luck. However once that would be functioning the "Add To" combo box selection in the user form would specify the range in the ECA worksheet to place that data. In the combo box selection, selecting "Keep" would place that information in range S3:Y16, "Remove" would be range S18:Y32, and "Final" would be range S35:Y47. Since numerous pieces of equipment would be added into each section when adding a piece of equipment it would place that entry in the next empty row of that range.

Link To Workbook

Picture Of Worksheets Master Sheet ECA Sheet

Dependent Drop Down Code

Private Sub cmbAddTo_Click()
'code needed to copy and add to selected range
End Sub

Private Sub cmdCancel_Click()
frmUser.Hide
End Sub

Private Sub UserForm_Initialize()
cmbCategory.RowSource = DynamicList(1, Null, 1, "Master Sheet", "Drop Down")
End Sub

Private Sub cmbCategory_Change()
cmbMake.RowSource = DynamicList(1, cmbCategory.Value, 2, "Master Sheet", "Drop Down")
End Sub

Private Sub cmbMake_Change()
cmbModel.RowSource = DynamicList(2, cmbMake.Value, 3, "Master Sheet", "Drop Down")  
End Sub
vba excel
1 Answers

Here is how I did it:

  • Function wsECA: Refers to the ECA worksheet
  • Enum SectonType: Numbers the sections
  • Function ECASection: Returns the range of a section
  • Function ECANewRow: Returns the range of the next empty row
  • Sub AddECANewRow: Add variable number of values to the new section row

Code

Public Enum SectonType
    stExistingToRemain = 1
    stRemoving
    stFinal
End Enum

Public Sub AddECANewRow(SectionNumer As SectonType, ParamArray Values() As Variant)
    Dim NewRow As Range
    Set NewRow = ECANewRow(SectionNumer)
    NewRow.Resize(1, UBound(Values) + 1).Value = Values
End Sub

Public Function wsECA() As Worksheet
    Set wsECA = ThisWorkbook.Worksheets("ECA")
End Function

Public Function ECANewRow(ByVal SectionNumer As SectonType) As Range
    Const LastColumn = 10
    Dim Section As Range
    
    Set Section = ECASection(SectionNumer)
    Dim LastUsedRow As Long
    Dim ColumnLastUsedRow As Long

    For c = 2 To LastColumn
        With Section.Columns(c)
            ColumnLastUsedRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            If ColumnLastUsedRow > LastUsedRow Then LastUsedRow = ColumnLastUsedRow
        End With
    Next
    LastUsedRow = LastUsedRow - Section.Row + 1
    
    Set ECANewRow = Section.Cells(LastUsedRow + 1, 2).Resize(1, LastColumn - 1)
End Function

Function ECASection(ByVal SectionNumer As SectonType) As Range
    Dim Target As Range
    With wsECA
        Set Target = Range("P2", .Cells(.Rows.Count, "P").End(xlUp))
    End With
    
    Dim MergedArea As Range
    Dim Cell As Range
    For Each Cell In Target

        If Cell.MergeArea.Rows.Count > 1 Then
            If MergedArea Is Nothing Then
                Set MergedArea = Cell.MergeArea
                SectionNumer = SectionNumer - 1
            ElseIf MergedArea.Address <> Cell.MergeArea.Address Then
                Set MergedArea = Cell.MergeArea
                SectionNumer = SectionNumer - 1
            End If
            If SectionNumer = 0 Then Exit For
        End If
    Next
    If Not MergedArea Is Nothing Then
        Set ECASection = Range(MergedArea, MergedArea.EntireRow.Columns("AA"))
    End If
End Function

Test

Application.Goto ECANewRow(stExistingToRemain), True
AddECANewRow stExistingToRemain,"Remain" ,3,,"Ford", "Mustang"

Application.Goto ECANewRow(stRemoving), True
AddECANewRow stFinal,"Removing" ,3,,"Chevy", "Tahoe"

Application.Goto ECANewRow(stFinal), True
AddECANewRow stRemoving,"Final" ,3,,"Dodge", "Journey"
user_99127140
Related