Home > OS >  Need to copy new information to one of two other worksheets based on the selected dropdown menu
Need to copy new information to one of two other worksheets based on the selected dropdown menu

Time:04-02

I have 3 worksheets used by 3 different people. Sheet "Builder Contact" needs to feed into either sheet "Res Jobs" if "Res" is selected or into "Comm Jobs" if "Comm" is selected. The information being copied isn't going to same column (ex. "Builder Contact" column 1, 10, 2, 4, 5 would be "Res Jobs" column 1, 2, 3, 7, 8 respectively).

I also need this to be updated automatically when "Res" or "Comm" is selected from the drop down menu in the "Builder Contact" Sheet. My current code can currently do it, but I have to hit run every time and it repeats everything because of the loop. But the loop is how I am currently getting the "x" value I need to find which row to copy all of the information.

Sub Res_Comm()
    Sheets("Builder Contact").Select
    ' Find the last row of data
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    ' Loop through each row
    For x = 2 To FinalRow
        ' Decide if to copy based on column K (column with the drop down menu to select "Res" or "Comm")
        ThisValue = Cells(x, 11).Value
        If ThisValue = "Res" Then
            Cells(x, 1).Copy
            Sheets("Res Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row   1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 10).Copy
            Sheets("Res Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 2).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 2).Copy
            Sheets("Res Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 3).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 4).Copy
            Sheets("Res Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 7).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 5).Copy
            Sheets("Res Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 8).Select
            ActiveSheet.Paste
            ' This column is asking for the source, which in this case would be the name of the user for "Builder Contact"
            Cells(NextRow, 6).Value = "Dan"
            
            
            
        ElseIf ThisValue = "Comm" Then
            Cells(x, 1).Copy
            Sheets("Comm Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row   1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 10).Copy
            Sheets("Comm Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 3).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 2).Copy
            Sheets("Comm Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 4).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 4).Copy
            Sheets("Comm Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 8).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 5).Copy
            Sheets("Comm Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 9).Select
            ActiveSheet.Paste
            
            Cells(NextRow, 7).Value = "Dan"
        End If
    Next x
End Sub

[Builder Contact][1][Res Jobs][2]

It won't let me add the photos directly yet, but hopefully the links work. [1]: enter image description here

Then paste in this code:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim s As Worksheet
    Dim source_columns As Variant
    Dim dest_columns As Variant
    Dim next_row As Long
    Dim x As Long
    
    If Target.Column = 11 Then
        If Target.Value = "Res" Then
            Set s = Sheets("Res Jobs")
            dest_columns = Array(1, 2, 3, 7, 8)
        ElseIf Target.Value = "Comm" Then
            Set s = Sheets("Comm Jobs")
            dest_columns = Array(1, 3, 4, 8, 9)
        Else
            Exit Sub
        End If
        
        source_columns = Array(1, 10, 2, 4, 5)
        
        next_row = s.Cells(s.Rows.Count, 1).End(xlUp).Row   1
        
        For x = 0 To UBound(source_columns)
             s.Cells(next_row, dest_columns(x)).Value = Cells(Target.Row, source_columns(x))
        Next

        s.Cells(next_row, 6).Value = "Dan"
        
    End If

End Sub

CodePudding user response:

It sounds like you want the user to choose from a dropdown list and then run the code you provided. If so, you want to put a "form-control comboxbox" on the worksheet. Here's where you find it on the developer tab of the ribbon.

enter image description here

Once you place the combobox on the sheet, right-click it and choose "Format Control"

enter image description here

This will allow you to configure the control. Under "Input Range", select the range where you have the values you want to appear in the list of possibilities. Under "cell link" put the cell where you want the value to go. In that cell, you will get a number that indicates which item is selected. Change your code to act differntly based on that number instead of res/comm.

Finally, right-click the combobox and choose "assign macro" to choose the macro you want to run when the user makes a choice.

enter image description here

  • Related