Compare the unique code numbers and highest rates among the unique ID number in two sheets

Question

There are two sheets Kevin and James. Both the sheets have unique code numbers and rates. The code below is to find out the unique code numbers in both sheets and the highest rates among the unique codes and result will be in a separate Summary sheet. Could you let me know where the code is wrong.

 Sub Loop10Q4Ver1()
       Sheets("Kevin").Select
       Range("A2").Select
       Sheets("James").Select
       Range("A2").Select
    Sheets("Summary").Select
    Range("A2").Select
    
    Do
        
        Sheets("Kevin").Select
        varcode = ActiveCell
        varrate = ActiveCell.Offset(0, 1)
        ActiveCell.Offset(1, 0).Select
    
    Do
        Sheets("James").Select
            If ActiveCell = varcode Then
                Sheets("Summary").Select
                ActiveCell = varcode
                ActiveCell.Offset(1, 0).Select
                Else
                Sheets("James").Select
                ActiveCell.Offset(1, 0).Select
            End If
                
        Sheets("James").Select
            If ActiveCell.Offset(0, 1) > varrate Then
                Sheets("Summary").Select
                ActiveCell.Offset(0, 1) = varrate
                Else
                Sheets("James").Select
                ActiveCell.Offset(1, 0).Select
            End If
    Loop Until IsEmpty(ActiveCell)
    
    Loop Until IsEmpty(ActiveCell)

End Sub

I recommend you start out by adding Option Explicit to the top of your module and Dim all your variables. Then read this: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba, Then try again. — Nicholas Hunter, Apr 03 '21 at 18:31
You may benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — Foxfire And Burns And Burns, Apr 03 '21 at 18:38
Consider using [consolidate](https://support.microsoft.com/en-us/office/consolidate-data-in-multiple-worksheets-007ce8f4-2fae-4fea-9ee5-a0b2c9e36d9b) to get the max rate between common ids. And yes, this can be done using VBA. — Foxfire And Burns And Burns, Apr 03 '21 at 18:45

score 0 · Accepted Answer · answered Apr 04 '21 at 17:09

Don't use Select and ActiveCell refer to the cell you want with Cells(rowno,column)

Option Explicit

Sub Loop10Q4Ver1()

    Dim wb As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, wsSum As Worksheet
    Dim j As Long, k As Long
    Dim code1 As String, rate1 As Single, code2 As String, rate2 As Single

    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Kevin")
    Set ws2 = wb.Sheets("James")
    Set wsSum = wb.Sheets("Summary")
    wsSum.Range("A1:D1") = Array("Code", "Kevin Rate", "James Rate", "Max")
    wsSum.Range("A1:D1").Font.Bold = True

    ' scan kevin
    k = 2
    Do While ws1.Cells(k, "A") <> ""
        code1 = ws1.Cells(k, "A")
        rate1 = ws1.Cells(k, "B")
        wsSum.Cells(k, "A") = code1
        wsSum.Cells(k, "B") = rate1
        wsSum.Cells(k, "D").FormulaR1C1 = "=MAX(RC[-1],RC[-2])"
        ' scan james
        j = 2
        Do While ws2.Cells(j, "A") <> ""
           code2 = ws2.Cells(j, "A")
           rate2 = ws2.Cells(j, "B")
           If code1 = code2 Then
               wsSum.Cells(k, "C") = rate2
           End If
           j = j + 1
        Loop
        k = k + 1
    Loop
    wsSum.Columns("A:D").AutoFit
    wsSum.Activate
    MsgBox "Done"

End Sub

Compare the unique code numbers and highest rates among the unique ID number in two sheets

1 Answers1