Excel VBA if condition then copy other cells to another worksheet

[wdg1]

So, I have worksheet 1 ("Start"), with a dropdown list of 15 articles.
When 1 article is chosen, the other fiels indicate:
article-name, number, price, VAT and total.
Now, I want to copy this data into a second worksheet ("list"),
where the data must be copied into columns, depending the article choice.
When (worksheet 1, article "1") copy to (worksheet 2, row 1)
When (worksheet 1, article "2") copy to (worksheet 2, row 2)
When (worksheet 1, article "1") copy to (worksheet 2, row 3)
...


The macro works fine, but the VBA code seems te be "long" (8 lines for 1 choice).
Can that code be compressed?



Sub verwerk()
Dim cell As Range
Sheets("Start").Select
If Range("B8").Value = 2 Then _
Sheets("list").Select
Range("B2").Select 'deze cel moet gevuld zijn!
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
ActiveSheet.Unprotect
Cells(rij, 2) = Range("Start!subtot")
Sheets("Start").Select
If Range("B8").Value = 3 Then _
Sheets("list").Select
Range("C2").Select 'deze cel moet gevuld zijn!
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
ActiveSheet.Unprotect
Cells(rij, 3) = Range("Start!subtot")
Sheets("Start").Select
Sheets("Start").Select
If Range("B8").Value = 4 Then _
Sheets("list").Select
Range("D2").Select 'deze cel moet gevuld zijn!
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
ActiveSheet.Unprotect
Cells(rij, 4) = Range("Start!subtot")
Sheets("Start").Select
Sheets("Start").Select
If Range("B8").Value = 5 Then _
Sheets("list").Select
Range("E2").Select 'deze cel moet gevuld zijn!
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
ActiveSheet.Unprotect
Cells(rij, 5) = Range("Start!subtot")
Sheets("Start").Select
Sheets("Start").Select
If Range("B8").Value = 6 Then _
Sheets("list").Select
Range("F2").Select 'deze cel moet gevuld zijn!
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
ActiveSheet.Unprotect
Cells(rij, 6) = Range("Start!subtot")
Sheets("Start").Select
Sheets("Start").Select
If Range("B8").Value = 7 Then _
Sheets("list").Select
Range("G2").Select 'deze cel moet gevuld zijn!
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
ActiveSheet.Unprotect
Cells(rij, 7) = Range("Start!subtot")
Sheets("Start").Select
Sheets("Start").Select
If Range("B8").Value = 8 Then _
Sheets("list").Select
Range("H2").Select 'deze cel moet gevuld zijn!
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
ActiveSheet.Unprotect
Cells(rij, 8) = Range("Start!subtot")
Sheets("Start").Select
Sheets("Start").Select
If Range("B8").Value = 9 Then _
Sheets("list").Select
Range("C2").Select 'deze cel moet gevuld zijn!
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
ActiveSheet.Unprotect
Cells(rij, 9) = Range("Start!subtot")
Sheets("Start").Select
' end so further to article 15
End Sub


Thanks.2947229472

[Aussiebear]

If you think about the logic of your code, then perhaps you need to consider use Case Select as your method

[wdg1]

Thanks, Aussiebar.
I changed the vba code to
-------------

Sub Select_and_copy_data()
Dim score As Integer
Dim result As String
score = Range("B8")
Select Case score
Case Is = 1
Sheets("List").Select
Range("A2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 1) = Range("Start!subtot")
Case Is = 2
Sheets("List").Select
Range("B2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 2) = Range("Start!subtot")
End Select
End Sub
-----
I will test this.
Thx, Ward, Belgium.

[Aussiebear]

You say the code works but it seems to be a series of confused code sections. Lets start with;

Sheets("Start").Select
If Range("B8").Value = 2 Then _
Sheets("list").Select
Range("B2").Select 'deze cel moet gevuld zijn!
Selection.End(xlDown).Select
I would replace that with


With Sheets("Start")
If .Range("B8").value = 2 Then
With Sheets("List")
.Range("B2: & .Range("B2").End(xlDown)).Select


but what do you intend to do with this range once you have selected it?


rij = 1 + ActiveCell.Row
ActiveSheet.Unprotect
Cells(rij, 2) = Range("Start!subtot")

I'm not sure what you intend to do here with this, since until now "rij" is a new term. Is it meant to be a defined name for the newly selected range starting at cell B2?

[Paul_Hossler]

Since Range("B8") seems to relate to the column number, I'd use that .Value



Option Explicit


Sub verwerk_1()
Dim B8 As Double
Dim rij As Long


B8 = Sheets("Start").Range("B8").Value

With Sheets("list")
.Unprotect
rij = 1 + .Cells(2, B8).End(xlDown).Row
.Cells(rij, B8) = Range("Start!subtot")
End With


End Sub

[wdg1]

The name "rij" is Belgium language, which has not to be defined.
As mentioned earlier, I have to choose an article from a dropdown list, choose "number of articles", then copy the (name + numer) of the article, the price (without VAT) into worksheet 2.
As there are 20 articles, 8 of 20 have to be listed up in 1 category, 6 of 20 in another category, and 6 in 6 other categories.
Then, the 13 categories must be sumarized to a total. Finally, VAT must be added.
In a second move, every action has to be listed, row after row, summarised, and VAT added.
As mentioned before, the golden tip to use "Case Select" made this code working perfect.
The dropdownlist choice puts the selecton in cells, (1) number (1-20), (2) name article, (3) number of articles, (4) price.
Then, this 4 values are copied into worksheet 2.
Depending of the article-number (1-20), the values are copied into other colums.
In that column, we search for the last row, then add the new value 1 row lower (free row).

I added 20x a "Case select", in my VBO code.
This could be shorter, but it works now.

[wdg1]

Sub Select_and_copy_data()
Dim score As Integer
Dim result As String
score = Range("B8")
Select Case score
'kosten opstarten
Case Is = 1
Sheets("List").Select
Range("A2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 1) = Range("Start!subtot")
'Brief partijen
Case Is = 2
Sheets("List").Select
Range("B2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 2) = Range("Start!subtot")
' mail partijen
Case Is = 3
Sheets("List").Select
Range("C2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 3) = Range("Start!subtot")
' AR brief Aangetekende brief
Case Is = 4
Sheets("List").Select
Range("D2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 4) = Range("Start!subtot")
' Kosten inkomende brief of mail
Case Is = 5
Sheets("List").Select
Range("E2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 5) = Range("Start!subtot")
' Openen email en onmiddellijk beantwoorden
Case Is = 6
Sheets("List").Select
Range("F2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 6) = Range("Start!subtot")
' Studie van de door partijen verstrekte documenten
Case Is = 7
Sheets("List").Select
Range("G2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 7) = Range("Start!subtot")
' Zitting: voorbereiding, ondervraging, fysiek onderzoek, bespreking met partijen
Case Is = 8
Sheets("List").Select
Range("H2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 8) = Range("Start!subtot")
' Studie van het dossier en ev opzoekingswerk
Case Is = 9
Sheets("List").Select
Range("I2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 9) = Range("Start!subtot")
' Uitwerken en opstellen van het deskundig verslag met bespreking en besluit
Case Is = 10
Sheets("List").Select
Range("J2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 10) = Range("Start!subtot")
' Beantwoorden van opmerkingen
Case Is = 11
Sheets("List").Select
Range("K2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 11) = Range("Start!subtot")
' Uurloon deskundige
Case Is = 12
Sheets("List").Select
Range("L2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 12) = Range("Start!subtot")
' Kosten aanslag desk verslag
Case Is = 13
Sheets("List").Select
Range("M2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 13) = Range("Start!subtot")
' Uurloon secretariaat
Case Is = 14
Sheets("List").Select
Range("N2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 14) = Range("Start!subtot")
' Print deskundig verslag en stukkenbundel per pagina
Case Is = 15
Sheets("List").Select
Range("O2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 15) = Range("Start!subtot")
' Fotografie afdruk per pagina
Case Is = 16
Sheets("List").Select
Range("P2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 16) = Range("Start!subtot")
' Sapiteur kosten
Case Is = 17
Sheets("List").Select
Range("Q2").Select
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 17) = Range("Start!subtot")
End Select
Call verwerk
End Sub

Sub verwerk()
Dim cell As Range
Sheets("list").Select
Range("Y1").Select 'deze cel moet gevuld zijn!
Selection.End(xlDown).Select
rij = 1 + ActiveCell.Row
Cells(rij, 25) = Range("Start!inhoud2")
Cells(rij, 26) = Range("Start!aantal")
Cells(rij, 27) = Range("Start!exclBTW")
Cells(rij, 28) = Range("Start!subtot")
End Sub

[Aussiebear]

Wdg1... did you take any notice of the sections of code that both Paul & I provided? .Select is a function of automated code but.... it slows your code down. Seriously you need to develop a system of limiting its use.

[Paul_Hossler]

You don't need Case 1 to Case 17 or even a Select Case

Take the smart way and use 'score' and compute 'rij'