Compare Two Sheets (A and B) and copy & hilight differences to bottom of B

Status
Not open for further replies.

MarqyMarq

New Member
Joined
Oct 22, 2015
Messages
30
Office Version
  1. 2016
Platform
  1. Windows
I have been reading various posts on comparing sheets, and I am pretty close to my solution. Just need a little bit of help on the "compare and copy over to new sheet".

I have two sheets (Summary) and (Tutor Attendance).

Problem 1: I am trying to copy the monthly Summary totals to the Tutoring Attendance for each respective month. If there are NEW entries, then they would be added to bottom, hi-light in Yellow and then sorted by grade (I can do this part).

Problem 2: Each row in Summary has some values (Required and Actual) which will need to be copied over to each respective month in Tutoring Attendance sheet.

Monthly Summary Sheet Shown Below
1626024875724.png


Tutoring Attendance (Year) Shown below with 2 new students added (in YELLOW)
1626026107706.png


In reading Fluff's solution in another post, I thought I could modify his code to work with mine. Was not successful bc of the JOIN(Application.Index).

I am looking for another solution as my code does not work to append NEW students to an existing list.

Thank you folks on MrExcel... you do make a difference!

Here is what I have so far: My current code can create NEW Tutoring Attendance list but I cannot append new students to existing student list.
VBA Code:
Sub Populate_Tutor_Attendance()

On Error Resume Next

Dim wSTD As Worksheet   '   Defined for STUDENT worksheets
Dim wTA As Worksheet    '   Defined for Tutoring Attendance worksheet
Dim lr As Integer, lrt As Integer   '   Defined to count the number of populated cells in row B of Tutoring Attendance worksheet

Set wTA = Worksheets("Tutoring Attendance")
wTA.Activate    'Activates Tutoring Attendance worksheet

lr = 0          'Sets LR count to "0"
lrt = wTA.Cells(Rows.Count, 2).End(xlUp).Row - 4   'Counts the number of Student Names in row B of Tutoring Attendance worksheet

'Screen does not update from changing sheets
Application.ScreenUpdating = False
   
'Copy contents from Student worksheets to Tutor Attendance sheet
    For Each wSTD In Worksheets
        
        ' Check to see if Students name is present on Tutor Attendance List
            
        ' **** Need code here to compare both sheets and add new students to bottom of list ****
        ' **** NEW code would replace code below:  ****
                
        'IF NOT Present then add names to bottom of list
        If wSTD.Name <> "Instructions" And wSTD.Name <> "Version_Data" And wSTD.Name <> "Summary" And wSTD.Name <> "Tutoring Attendance" And wSTD.Name <> "Master" And wSTD.Name <> "Table Of Contents" Then
          With wSTD
            wSTD.Range("B1").Copy     'Student Name
            wTA.Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            wSTD.Range("F1").Copy     'Grade
            wTA.Range("B65536").End(xlUp).Offset(0, 1).PasteSpecial xlPasteValues
            wSTD.Range("A4").Copy     'Subject
            wTA.Range("B65536").End(xlUp).Offset(0, 2).PasteSpecial xlPasteValues
            
            lr = lr + 1     'Increment lr count by 1
            lrt = lrt + 1
        
        ' If Names are Present then add values to month column
        ' Finds month from Instructions page and and finds column in Tuturoing Attendance  rFind = columncount#
            Dim rFind As Range 'defined to identify column count
            With wTA.Range("E3:U3")
             Set rFind = .Find(What:=Worksheets("Instructions").Range("D4"), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
             If Not rFind Is Nothing Then
             'MsgBox rFind.Column
             End If
            End With
               
            wSTD.Range("F2").Copy     'Times Required This Month
            wTA.Range("B65536").End(xlUp).Offset(0, rFind.Column - 1).PasteSpecial xlPasteValues    ' Subtracts 2 from previous offset above
            wSTD.Range("F3").Copy     'Times Tutored This Month
            wTA.Range("B65536").End(xlUp).Offset(0, rFind.Column - 2).PasteSpecial xlPasteValues    ' Subtracts 1 from previous offset above
                          
          End With
        End If
    Next wSTD
'
' Sorts the Summary Sheet by Grade(ColumnC)and then by Last Name(ColumnB)
  
'  Range("C7").Select

Application.ScreenUpdating = True
wTA.Activate

'Message box that Summary Sheet Created was successful
MsgBox ("    Tutor Attendance Report Generated!" & vbNewLine & vbNewLine & "Updated With Current Months Data!"), _
       vbInformation, Title:="Generate TUTOR Report"

'lr = wSTD.Cells(Rows.Count, 2).End(xlUp).Row
 
MsgBox lr & " Students Updated!" & vbNewLine & vbNewLine & lrt & " Total students Listed"

End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Status
Not open for further replies.

Forum statistics

Threads
1,224,818
Messages
6,181,150
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top