Excel/VB

[DarReNz]

Hi, i can't seem to be able to paste the all the values from column B1("Input") to row 4("Bau") onwards. Only the 'Jack' appears as you can see from below. any help? Thanks a million.

row 3 1 Darren 1-Jan 1-Oct a b c d e $1.00
row 4 2 Jack


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect([B21], Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Worksheets("Bau").Range("B3") = "" Then
Worksheets("Bau").Range("B65536").End(xlUp).Offset(1, 0).Value = [B1].Value
Worksheets("Bau").Range("B65536").End(xlUp).Offset(0,1).Value = [B4].Value
Worksheets("Bau").Range("B65536").End(xlUp).Offset(0,2).Value = [B5].Value
Worksheets("Bau").Range("B65536").End(xlUp).Offset(0, 6).Value = [B15].Value
Worksheets("Bau").Range("B65536").End(xlUp).Offset(0, 7).Value = [B17].Value
Worksheets("Bau").Range("B65536").End(xlUp).Offset(0, 8).Value = [B19].Value
Worksheets("Bau").Range("B65536").End(xlUp).Offset(0, 9).Value = [B21].Value
Range("B1:B21").ClearContents
Else
Worksheets("Input").Range("B1").CurrentRegion.Columns(2).Copy
Worksheets("Bau").Range("B2").End(xlDown).Offset(1).PasteSpecialTranspose:=True
Range("B1:B21").ClearContents
End If
Application.EnableEvents = True
Exit Sub
End Sub

[Bob Phillips]

Hi, i can't seem to be able to paste the all the values from column B1("Input") to row 4("Bau") onwards. Only the 'Jack' appears as you can see from below. any help? Thanks a million.

row 3 1 Darren 1-Jan 1-Oct a b c d e $1.00
row 4 2 Jack


When you do Range("B1").CurrentRegion.Columns(2) you are actually referring to column C. Perhaps you mean



Private Sub Worksheet_Change(ByVal Target As Range)
Dim iLastRow As Long
Dim iLastCol As Long
If Intersect([B21], Target) Is Nothing Then Exit Sub
On Error GoTo ws_exit:
Application.EnableEvents = False
With Worksheets("Bau")
If .Range("B3") = "" Then
iLastRow = .Range("B" & Rows.Count).End(xlUp).Row
.Cells(iLastRow, "B").Offset(1, 0).Value = [B1].Value
.Cells(iLastRow, "B").Offset(0, 1).Value = [B4].Value
.Cells(iLastRow, "B").Offset(0, 2).Value = [B5].Value
.Cells(iLastRow, "B").Offset(0, 6).Value = [B15].Value
.Cells(iLastRow, "B").Offset(0, 7).Value = [B17].Value
.Cells(iLastRow, "B").Offset(0, 8).Value = [B19].Value
.Cells(iLastRow, "B").Offset(0, 9).Value = [B21].Value
Range("B1:B21").ClearContents
Else
iLastCol = Worksheets("Input").Cells(2, Columns.Count).End(xlToLeft).Column
Worksheets("Input").Range("B1").Resize(, iLastCol).Copy
.Range("B2").End(xlDown).Offset(1).PasteSpecial Transpose:=True
Range("B1:B21").ClearContents
End If
End With

ws_exit:
Application.EnableEvents = True
End Sub

[DarReNz]

hi, i tried your code and the result is still the same

row 3 1 Darren 1-Jan 1-Oct a b c d e $1.00
row 4 2 Jack
row 5 3 Sam

This is from input worksheet

column A column B
Desc Darren

Sch
StartD 1-Jan
EndD 1-Oct

any other reasons why it doesn't show up on the rest of the rows in Bau ?

[Bob Phillips]

hi, i tried your code and the result is still the same

row 3 1 Darren 1-Jan 1-Oct a b c d e $1.00
row 4 2 Jack
row 5 3 Sam

This is from input worksheet

column A column B
Desc Darren

Sch
StartD 1-Jan
EndD 1-Oct

any other reasons why it doesn't show up on the rest of the rows in Bau ?

Post the workbook.

[DarReNz]

Here is the Input worksheet.

[DarReNz]

Here is the bau worksheet. Only the value from Desc is copied and the rest of the values are not. Any ideas ?

[Bob Phillips]

No I mean attach the workbook to your reply. Just scroll down and click manage attachments.

[DarReNz]

do you mean upload the zip file ?

[xCav8r]

He does. :)

[DarReNz]

ok here it is xld :bow:

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iLastRow As Long
If Target.Address = "$B$19" Then
Application.EnableEvents = False
On Error GoTo ws_exit:
With Worksheets("Bau")
iLastRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
.Cells(iLastRow, "B").Value = Range("B1").Value
.Cells(iLastRow, "C").Value = Range("B4").Value
.Cells(iLastRow, "D").Value = Range("B5").Value
.Cells(iLastRow, "E").Value = Range("B7").Value
.Cells(iLastRow, "F").Value = Range("B9").Value
.Cells(iLastRow, "G").Value = Range("B11").Value
.Cells(iLastRow, "H").Value = Range("B13").Value
.Cells(iLastRow, "I").Value = Range("B15").Value
.Cells(iLastRow, "J").Value = Range("B17").Value
.Cells(iLastRow, "K").Value = Range("B19").Value
Range("B1:B21").ClearContents
End With
End If

ws_exit:
Application.EnableEvents = True
Exit Sub
End Sub

[DarReNz]

Thanks xld, btw how do I make the selected value in the drop down list B11(Input) copied into G3(Bau) and the rest of the rows ? Thanks a lot.

[malik641]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim iLastRow As Long
Dim DropDown As Object
Dim i As Long

Set DropDown = ActiveSheet.Shapes("Drop Down 13").ControlFormat
i = DropDown.Value

If Target.Address = "$B$19" Then
Application.EnableEvents = False
On Error GoTo ws_exit:
With Worksheets("Bau")
iLastRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
.Cells(iLastRow, "B").Value = Range("B1").Value
.Cells(iLastRow, "C").Value = Range("B4").Value
.Cells(iLastRow, "D").Value = Range("B5").Value
.Cells(iLastRow, "E").Value = Range("B7").Value
.Cells(iLastRow, "F").Value = Range("B9").Value
.Cells(iLastRow, "G").Value = DropDown.List(i)
.Cells(iLastRow, "H").Value = Range("B13").Value
.Cells(iLastRow, "I").Value = Range("B15").Value
.Cells(iLastRow, "J").Value = Range("B17").Value
.Cells(iLastRow, "K").Value = Range("B19").Value
Range("B1:B21").ClearContents
End With
End If

ws_exit:
Application.EnableEvents = True
Exit Sub
End Sub
Just a little mod of xld's submission :thumb

EDIT: Be careful! If there is nothing selected in the drop box, you will get an error. So I placed the On Error Resume Next code there just incase.

[DarReNz]

Thanks malik,

I wish to enquire about list box too. I want to position the list box at B9(Input) and multiple selection can be selected. The values are seperated by commas and passed onto F3(Bau) onwards. The parameters can be found on the Param worksheet under Implementor. Any help is appreciated thanks.

[Bob Phillips]

Thanks malik,

I wish to enquire about list box too. I want to position the list box at B9(Input) and multiple selection can be selected. The values are seperated by commas and passed onto F3(Bau) onwards. The parameters can be found on the Param worksheet under Implementor. Any help is appreciated thanks.

Same approach, the listbox will have a name of List Box n instead of Drop Down n, such as

With ActiveSheet.ListBoxes("List Box 3")
MsgBox Range(.ListFillRange).Cells(.Value)
End With

[DarReNz]

hmm is the below correct ? Multiple values that I have selected in the list box to be seperated by commas doesn't seem to be passed to Bau ..... any help ?

Set ListBox = ActiveSheet.Shapes("List Box 17").ControlFormat

With ActiveSheet.ListBoxes("List Box 17")
MsgBox Range(.ListFillRange).Cells(.Value)
End With

.Cells(iLastRow, "F").Value = ListBox.List