Comparing columns and transferring data

user_2576252 0
Viewed 66

I am comparing two sheets and their columns. My code runs. Problem is it compares most of the values and leaves some values though they are the same.

Sub Peformance()
Dim k As Integer
Dim i As Integer
Dim j As Integer
For i = 1 To 138
    If (ActiveWorkbook.Worksheets("report").Cells(i, 6).Value = "course-1") Then
        For j = 1 To 138
            If (ActiveWorkbook.Worksheets("report").Cells(i, 1).Value = Cells(j, 1)) Then
                Cells(j, 4).Value = (ActiveWorkbook.Worksheets("report").Cells(i, 12).Value) / 100
                Cells(j, 5).Value = (ActiveWorkbook.Worksheets("report").Cells(i, 20).Value) / 100
                Cells(j, 6).Value = (ActiveWorkbook.Worksheets("report").Cells(i, 13).Value)
            End If
        Next j
    End If
Next i

For k = 1 To 138
    If (IsEmpty(Cells(k, 4).Value)) Then
        Cells(k, 4).Value = 0
        Cells(k, 5).Value = 0
    End If
    If (IsEmpty(Cells(k, 6).Value)) Then
        Cells(k, 6).Value = 0
    End If



End Sub

In one file (sheet-2) I have students courses like course-1, course-2, course-3 etc.
In the other file (sheet-1) I have students names.

After comparing names (Column-1 of sheet-2 and sheet-1) I have to copy the performance from sheet-2 to sheet-1.

It runs but is not showing output for some students whose names are same.
Also how can I add the feature of case sensitive?

Sample Data

Sheet2:

Name Email External Course Course-ID Course-Slug Work-Percentage
A a@gmail.com 12 A course course-1 63%
B b@gmail.com 13 A course course-1 19%

Sheet1:

Name Work-Percentage
A
B

So sheet1 column Work-Percentage will copy data from Work-Percentage column after comparing the name and course-Slug from sheet-2

vba excel
1 Answers

Double For...Next

  • Adjust the name of the Destination Worksheet (dws) because I named it Course-1.
  • StrComp is taking care of the case-sensitivity issues.
  • This is just a quick fix for you to learn (understand). Otherwise, the efficiency can vastly be improved.
  • Not tested.

The Code

Option Explicit

Sub Peformance()
    
    ' Constants
    Const sFirstRow As Long = 2
    Const dFirstRow As Long = 2
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets("Report")
    Dim sLastRow As Long: sLastRow = sws.Cells(sws.Rows.Count, 1).End(xlUp).Row
    Dim k As Long
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets("Course-1")
    Dim dLastRow As Long: dLastRow = dws.Cells(dws.Rows.Count, 1).End(xlUp).Row
    Dim i As Long
    
    ' Loop
    For i = dFirstRow To dLastRow
        For k = sFirstRow To sLastRow
            If StrComp(sws.Cells(k, 6).Value, "course-1", vbTextCompare) = 0 _
                    And StrComp(dws.Cells(i, 1).Value, sws.Cells(k, 1).Value, _
                    vbTextCompare) = 0 Then
                ' Student was found in Source Worksheet.
                dws.Cells(i, 4).Value = sws.Cells(k, 12).Value / 100
                dws.Cells(i, 5).Value = sws.Cells(k, 20).Value / 100
                dws.Cells(i, 6).Value = sws.Cells(k, 13).Value
                Exit For ' Student was found, no need to loop any longer.
            End If
        Next k
        If k > sLastRow Then
            ' Student wasn't found in Source Worksheet.
            If IsEmpty(dws.Cells(i, 4)) Then
                If IsEmpty(dws.Cells(i, 6)) Then
                    dws.Cells(i, 4).Resize(3).Value = 0
                Else
                    dws.Cells(i, 4).Resize(2).Value = 0
                End If
            End If
        End If
    Next i

End Sub
user_98140690
Related