4
\$\begingroup\$

I wrote this code and it works fine for my purpose, to look for some values and copy paste the result to another sheet (online for selected column). I want to know the opinion from this community regarding my code. I just learned the VBA for 1 week.

Option Explicit

Sub Analysis_ClientRating()   
    Dim lastrow As Long, i As Long, rowppt As Long, colppt As Long
    Dim rowppt1 As Long, colppt1 As Long, rowppt2 As Long, colppt2 As Long
    Dim rowppt3 As Long, colppt3 As Long

    lastrow = ShNote.Range("C" & Rows.Count).End(xlUp).Row
    rowppt = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
    colppt = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
    rowppt1 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
    colppt1 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
    rowppt2 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
    colppt2 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
    rowppt3 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
    colppt3 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row

    Call Entry_Point

    For i = 6 To lastrow
        Select Case ShNote.Cells(i, 5).Value
            Case Is = 20
            ShNote.Cells(i, 3).Copy
            ShPPT.Cells(rowppt + 6, 3).PasteSpecial xlPasteValues
            ShNote.Cells(i, 5).Copy
            ShPPT.Cells(colppt + 6, 4).PasteSpecial xlPasteValues
            rowppt = rowppt + 1
            colppt = colppt + 1

            Case Is >= 17
            ShNote.Cells(i, 3).Copy
            ShPPT.Cells(rowppt1 + 6, 6).PasteSpecial xlPasteValues
            ShNote.Cells(i, 5).Copy
            ShPPT.Cells(colppt1 + 6, 7).PasteSpecial xlPasteValues
            rowppt1 = rowppt1 + 1
            colppt1 = colppt1 + 1

            Case Is >= 15
            ShNote.Cells(i, 3).Copy
            ShPPT.Cells(rowppt2 + 6, 9).PasteSpecial xlPasteValues
            ShNote.Cells(i, 5).Copy
            ShPPT.Cells(colppt2 + 6, 10).PasteSpecial xlPasteValues
            rowppt2 = rowppt2 + 1
            colppt2 = colppt2 + 1

            Case Is >= 11
            ShNote.Cells(i, 3).Copy
            ShPPT.Cells(rowppt3 + 6, 12).PasteSpecial xlPasteValues
            ShNote.Cells(i, 5).Copy
            ShPPT.Cells(colppt3 + 6, 13).PasteSpecial xlPasteValues
            rowppt3 = rowppt3 + 1
            colppt3 = colppt3 + 1
        End Select
    Next i

    Call Exit_Point
End Sub
\$\endgroup\$
2
  • \$\begingroup\$ Hello, Thanks for the great feedback from the members of this community. As @damian pointed out two specific variables "colppt & rowppt" that I declared several times due to my lack of experience in VBA. I have 2 sheets, one for database and the other one is for "the final result (FR) of the extraction of values from database". My FR sheet has 4 tables with 4 categories. First time, I wrote my code, I only declared "colppt & row ppt" after writing last case I mentionned rowppt = rowppt + 1 same as for col ppt. \$\endgroup\$ – C.Edo May 19 '19 at 18:24
  • \$\begingroup\$ When I run my code, the result for data ranges the first 3 tables is overlapping on the first row of each tables only the last table the data is shown at each row based on the condition met. Therefore, I declared several row ppt & col ppt to prevent the overlapping data range for the same row. \$\endgroup\$ – C.Edo May 19 '19 at 18:27
2
\$\begingroup\$

If you've only learned VBA a week ago, then congratulations and a good job getting a working solution! Hopefully the information and tips here can provide some help in refining not only your solution, but to help guide your code in the future.

You've avoided some basic traps because you're already using Option Explicit and you are assigning a type to each variable on the Dim line. Most professional VBA developers will advise that it's a better habit to declare each variable immediately before it's used, even down lower in the method. This avoids the "wall of declarations" up front.

You have a potential problem on the statement to determine the lastrow value. It's an easy thing to miss, but when you use Rows.Count, you are referring to the number of rows on the active worksheet, NOT the number of rows on ShNote (which is what you want). So the fully accurate line is

lastrow = ShNote.Range("C" & ShNote.Rows.Count).End(xlUp).Row

Of course the same thing goes for similar statements throughout your code.

(I'm skipping around in your code, it will all make sense in the end I promise)

The values that you're using in the Select Case statement are simple numbers, but those numbers are meaningless unless you give them context. What do those numbers mean in your workbook and for your data? Translate that "meaning" into your code. One way can be to create a set of constants. I've defined a set like this:

Const MAX_THRESHOLD As Long = 20
Const HIGH_THRESHOLD As Long = 17
Const MED_THRESHOLD As Long = 15
Const LOW_THRESHOLD As Long = 13

Now you can change the values just be changing the definitions, and your code makes more sense as you (or me) reads it.

Next, I have to question why you're calculating the same last row value on ShPPT eight times in a row. You can calculate it once, then copy the assignment to the other variables. You can also use more meaningful variable names, since we're defining why we're keeping track of the different rows.

Dim lastSourceRow As Long
lastSourceRow = ShNote.Range("C" & ShNote.Rows.Count).End(xlUp).Row

'--- start all the rows at the same value
Dim lastMaxRow As Long
Dim lastHighRow As Long
Dim lastMedRow As Long
Dim lastLowRow As Long
lastMaxRow = lastSourceRow
lastHighRow = lastSourceRow
lastMedRow = lastSourceRow
lastLowRow = lastSourceRow

The separate "counters" you had for the columns of each threshold hold the exact same value as the rows, so they aren't needed.

I see that each value is incremented separately, but there's also a very consistent pattern to the logic within each Case. When you see that, your first thought should be to break out a separate function that can isolate the logic in a single place. That makes it easier to change later. For example, your method could be

Private Function NowCopyPaste2(ByVal fromRow As Long, _
                               ByVal toRow As Long, _
                               ByVal toColumn As Long, _
                               ByRef fromWS As Worksheet, _
                               ByRef toWS As Worksheet) As Long
    fromWS.Cells(fromRow, 3).Copy
    toWS.Cells(toRow + 6, toColumn).PasteSpecial xlPasteValues
    fromWS.Cells(fromRow, 5).Copy
    toWS.Cells(toRow + 6, toColumn + 1).PasteSpecial xlPasteValues
    NowCopyPaste = toRow + 1
End Function

This produces the same logic that exists in your original post. However, you're using copy/paste to transfer a value from one cell to another and there's a much simpler way that uses far less resources. Just simply assign the value of one cell to the other. The improved NowCopyPaste function is

Private Function NowCopyPaste(ByVal fromRow As Long, _
                              ByVal toRow As Long, _
                              ByVal toColumn As Long, _
                              ByRef fromWS As Worksheet, _
                              ByRef toWS As Worksheet) As Long
    toWS.Cells(toRow + 6, toColumn).Value = fromWS.Cells(fromRow, 3).Value
    toWS.Cells(toRow + 6, toColumn + 1).Value = fromWS.Cells(fromRow, 5).Value
    NowCopyPaste = toRow + 1
End Function

Finally, the main logic of your code is more clear for the upfront work you've done and the clear definitions used:

'--- values are copied to the PowerPoint worksheet and sorted by
'    columns according to the threshold tests
Dim i As Long
For i = 6 To lastSourceRow
    Select Case ShNote.Cells(i, 5).Value
        Case Is = MAX_THRESHOLD
            lastMaxRow = NowCopyPaste(i, lastMaxRow, 3, ShNote, ShPPT)

        Case Is >= HIGH_THRESHOLD
            lastHighRow = NowCopyPaste(i, lastHighRow, 6, ShNote, ShPPT)

        Case Is >= MED_THRESHOLD
            lastMedRow = NowCopyPaste(i, lastMedRow, 9, ShNote, ShPPT)

        Case Is >= LOW_THRESHOLD
            lastLowRow = NowCopyPaste(i, lastLowRow, 12, ShNote, ShPPT)

        Case Else
            '--- what will you do here? (could be nothing but it's
            '    still a good idea to document with a comment that
            '    values in this range are not copied
    End Select
Next i

Notice that I also have used comments prior to each logic block that explain what the code does and why. This will always be important for maintaining the code, even if you are the only one to ever look at it again.

Here's the whole module in a single block:

Option Explicit

Public Sub AnalysisClientRating()
    Const MAX_THRESHOLD As Long = 20
    Const HIGH_THRESHOLD As Long = 17
    Const MED_THRESHOLD As Long = 15
    Const LOW_THRESHOLD As Long = 13

    Dim lastSourceRow As Long
    lastSourceRow = ShNote.Range("C" & ShNote.Rows.Count).End(xlUp).Row

    '--- start all the rows at the same value
    Dim lastMaxRow As Long
    Dim lastHighRow As Long
    Dim lastMedRow As Long
    Dim lastLowRow As Long
    lastMaxRow = lastSourceRow
    lastHighRow = lastSourceRow
    lastMedRow = lastSourceRow
    lastLowRow = lastSourceRow

    '--- I don't know what your entry and exit points do, but you should
    '    create a comment that gives the next developer an idea why these
    '    methods exist and why they are here. what do they do?
    Entry_Point

    '--- values are copied to the PowerPoint worksheet and sorted by
    '    columns according to the threshold tests
    Dim i As Long
    For i = 6 To lastSourceRow
        Select Case ShNote.Cells(i, 5).Value
            Case Is = MAX_THRESHOLD
                lastMaxRow = NowCopyPaste(i, lastMaxRow, 3, ShNote, ShPPT)

            Case Is >= HIGH_THRESHOLD
                lastHighRow = NowCopyPaste(i, lastHighRow, 6, ShNote, ShPPT)

            Case Is >= MED_THRESHOLD
                lastMedRow = NowCopyPaste(i, lastMedRow, 9, ShNote, ShPPT)

            Case Is >= LOW_THRESHOLD
                lastLowRow = NowCopyPaste(i, lastLowRow, 12, ShNote, ShPPT)

            Case Else
                '--- what will you do here? (could be nothing but it's
                '    still a good idea to document with a comment that
                '    values in this range are not copied
        End Select
    Next i

    Exit_Point

End Sub

Private Function NowCopyPaste(ByVal fromRow As Long, _
                              ByVal toRow As Long, _
                              ByVal toColumn As Long, _
                              ByRef fromWS As Worksheet, _
                              ByRef toWS As Worksheet) As Long
    toWS.Cells(toRow + 6, toColumn).Value = fromWS.Cells(fromRow, 3).Value
    toWS.Cells(toRow + 6, toColumn + 1).Value = fromWS.Cells(fromRow, 5).Value
    NowCopyPaste = toRow + 1
End Function

Private Sub Entry_Point()
    '--- does something interesting?
End Sub

Private Sub Exit_Point()
    '--- does something interesting?
End Sub
\$\endgroup\$
1
  • \$\begingroup\$ Wow, thank you for your complete feedback. I will learn your answer and try to apply to my module tomorrow. I am getting back to you for the final result. Thanks again. I really appreciate your time to refine my code. \$\endgroup\$ – C.Edo May 19 '19 at 18:11
0
\$\begingroup\$

This is all I can think of:

Option Explicit
Sub Analysis_ClientRating()
    Dim lastrow As Long, i As Long, rowppt As Long, rowppt1 As Long, _
    rowppt2 As Long, rowppt3 As Long

    lastrow = ShNote.Range("C" & ShNote.Rows.Count).End(xlUp).Row 'you need to qualify the Rows.count
    With shPPT 'you can use it so there is no need to write the sheet in between the with
        rowppt = .Cells(.Rows.Count, 1).End(xlUp).Row
        rowppt1 = rowppt 'them all gonna take the same value
        rowppt2 = rowppt
        rowppt3 = rowppt
    End With

    'colpptl are redundant since you are always taking the same value for all the variables and using them along with rowpptl

    Call Entry_Point

    For i = 6 To lastrow
        Select Case ShNote.Cells(i, 5).Value
            Case Is = 20
                shPPT.Cells(rowppt + 6, 3).Value = ShNote.Cells(i, 3).Value 'because you are copying just 1 cell to another (values) .Value = .Value is faster
                shPPT.Cells(rowppt + 6, 4).Value = ShNote.Cells(i, 5).Value
                rowppt = rowppt + 1

            Case Is >= 17
                shPPT.Cells(rowppt1 + 6, 6).Value = ShNote.Cells(i, 3).Value
                shPPT.Cells(rowppt1 + 6, 7).Value = ShNote.Cells(i, 5).Value
                rowppt1 = rowppt1 + 1

            Case Is >= 15
                shPPT.Cells(rowppt2 + 6, 9).Value = ShNote.Cells(i, 3).Value
                shPPT.Cells(rowppt2 + 6, 10).Value = ShNote.Cells(i, 5).Value
                rowppt2 = rowppt2 + 1

            Case Is >= 11
                shPPT.Cells(rowppt3 + 6, 12).Value = ShNote.Cells(i, 3).Value
                shPPT.Cells(rowppt3 + 6, 13).Value = ShNote.Cells(i, 5).Value
                rowppt3 = rowppt3 + 1

        End Select
    Next i

    Call Exit_Point
End Sub
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.