Copy Certain Cells to Another Sheet In Correct Row

[MarqyMarq]

Hi All! I am having an issue copying data (several fields) from one worksheet to another worksheet.... in the correct row of data.

The first sheet (Summary) has a a few student names and data listed. These names are compared to another sheet (Tutoring Attendance) and the "new" names added to the bottom of Tutoring Attendance. This part works!!!

Data in Columns D & E moved to certain columns based on the MONTH identified in Tutoring Attendance (Cell "B3"). This part also works.

The problem is my VBA code does NOT copy the remainder of the SUMMARY data (columns B thru E) to the correct student row listed in the Tutoring Attendance Tab. All I get it is the last row of data on the very last name of the Tutoring Attendance. I know I have a looping and an offset problem. Just can't figure it out.

Any assistance will be valuable.

Sub CopySummaryMonthlyData_TutoringMonthArea()

Dim wSum 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")
Set wSum = Worksheets("Summary")
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


    ' *** Insert Monthly Values to Proper Spot ***  TESTING 12 Aug 2021
    ' Objective:  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
    Dim IRg As Range, xCell As Range, ARg As Range, MReqRg As Range, MActRg As Range
                 
    ICount = wSum.Cells(Rows.Count, 1).End(xlUp).Row      ' Counts the number of used rows in Summary
    
    Set IRg = wSum.Range("I4:I" & ICount)   ' Sets the range in row I, which is the criteria column
    
    Set MReqRg = wSum.Range("D4:D" & ICount)  '  Sets the range for Column D "Monthly Required"
            Set MActRg = wSum.Range("E4:E" & ICount)  '  Sets the range for Column E "Monthly Actual"
            
                With wTA.Range("E3:U3")
                Set rFind = .Find(What:=wTA.Range("B3"), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
                    If Not rFind Is Nothing Then
                    MsgBox "The Month " & rFind & " is in column " & rFind.Column
                    End If
                End With
               
    ' *** Copy Student Monthly Values from Summary to Tutoring Attendance *** Does NOT WORK *** 12 Aug 2021 requesting help from experts ***
    For K = 1 To IRg.Count
        MReqRg(K).Cells.Copy     'Times Required This Month
        'MsgBox MReqRg(K).Value2          ' Displays values for code verification
        wTA.Range("B65536").End(xlUp).Offset(0, rFind.Column - 2).PasteSpecial xlPasteValues    ' Subtracts 2 from previous offset above
        
        MActRg(K).Cells.Copy     'Times Tutored This Month
        'MsgBox MActRg(K).Value2           ' Displays Values for code verification
        wTA.Range("B65536").End(xlUp).Offset(0, rFind.Column - 1).PasteSpecial xlPasteValues    ' Subtracts 1 from previous offset above
    
        lr = lr + 1     'Increment lr count by 1 when a Student is added to Tutoring Attendance
        lrt = lrt + 1
    Next
    
MsgBox lr & " Students Updated!" & vbNewLine & vbNewLine & lrt & " Total students Listed"
    
End Sub

 

[Alex Blakenburg]

In your code you were looping through the summary sheet but were not actually matching names to the Tutoring sheet and were always writing "required" and "actual "to the same row, being the last used row in column B
( eg wTA.Range("B65536").End(xlUp).Offset(0, rFind.Column - 2).PasteSpecial xlPasteValues)

See if the below works for you:

Sub CopySummaryMonthlyData_TutoringMonthArea()

    Dim wSum As Worksheet   '   Defined for STUDENT worksheets
    Dim wTA As Worksheet    '   Defined for Tutoring Attendance worksheet
   
    Dim ICount As Long
    Dim K As Long
    Dim rngSum As Range
    Dim arrSum As Variant
      
    Set wTA = Worksheets("Tutoring Attendance")
    Set wSum = Worksheets("Summary")
    
        ' *** Insert Monthly Values to Proper Spot ***  TESTING 12 Aug 2021
     ' Objective:  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
                 
     ICount = wSum.Cells(Rows.Count, 1).End(xlUp).Row      ' Counts the number of used rows in Summary
    
     Set rngSum = wSum.Range("A4:I" & ICount)
     arrSum = rngSum.Value
            
     With wTA.Range("E3:U3")
         Set rFind = .Find(What:=wTA.Range("B3"), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
             If Not rFind Is Nothing Then
             MsgBox "The Month " & rFind & " is in column " & rFind.Column
             End If
     End With
               
     ' *** Copy Student Monthly Values from Summary to Tutoring Attendance *** Does NOT WORK *** 12 Aug 2021 requesting help from experts ***
     For K = 5 To wTA.Cells(Rows.Count, 2).End(xlUp).Row
         wTA.Cells(K, 3).Value = Application.VLookup(wTA.Cells(K, 2), arrSum, 2, False)
         wTA.Cells(K, rFind.Column).Value = Application.VLookup(wTA.Cells(K, 2), arrSum, 4, False)
         wTA.Cells(K, rFind.Column + 1).Value = Application.VLookup(wTA.Cells(K, 2), arrSum, 5, False)
     Next
   
End Sub

 

[MarqyMarq]

' *** Copy Student Monthly Values from Summary to Tutoring Attendance *** Does NOT WORK *** 12 Aug 2021 requesting help from experts *** For K = 5 To wTA.Cells(Rows.Count, 2).End(xlUp).Row wTA.Cells(K, 3).Value = Application.VLookup(wTA.Cells(K, 2), arrSum, 2, False) wTA.Cells(K, rFind.Column).Value = Application.VLookup(wTA.Cells(K, 2), arrSum, 4, False) wTA.Cells(K, rFind.Column + 1).Value = Application.VLookup(wTA.Cells(K, 2), arrSum, 5, False) Next

Alex, thanks for the code. I did copy your FULL code base into mine. Your solution works... almost! I am not well versed in arrays, so I am having problems fixing what is not working with the code you provided.

In testing the code (I changed the names to the Summary list) and it works when the names are initially transferred over, so the Vlookup in the array is working.

However, it is showing "#NA" in the cells where the names in Summary do NOT match what is in Tutoring Attendance. This is possible if the Students are not tutored for a certain month. In this case, Bravo, Charlie, and Echo, were not tutored in the month of January, so they should be showing as "" (blank) for their respective cells in each month.

If you can look at the code and see what needs to be changed, I'd appreciate it.

 

[Alex Blakenburg]

Its nearly 1am here in Australia and I have logged off.
If you want to try changing the lookups by adding to the front-> Application.Iferror(
and to the end -> ,"")
eg
Application.Iferror(Application.VLookup(wTA.Cells(K, 2), arrSum, 2, False),"")

Otherwise I can have a look tomorrow.

 

[Alex Blakenburg]

I didn't hear back to know if you managed to make the modification yourself or not, so assuming you didn't below is the modified code.
Uses Iferror if the student was not found in the summary.

Sub CopySummaryMonthlyData_TutoringMonthArea()

    Dim wSum As Worksheet   '   Defined for STUDENT worksheets
    Dim wTA As Worksheet    '   Defined for Tutoring Attendance worksheet
    
    Dim ICount As Long
    Dim K As Long
    Dim rngSum As Range
    Dim arrSum As Variant
       
    Set wTA = Worksheets("Tutoring Attendance")
    Set wSum = Worksheets("Summary")
     
    ' *** Insert Monthly Values to Proper Spot ***  TESTING 12 Aug 2021
     ' Objective:  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
                  
     ICount = wSum.Cells(Rows.Count, 1).End(xlUp).Row      ' Counts the number of used rows in Summary
     
     Set rngSum = wSum.Range("A4:I" & ICount)
     arrSum = rngSum.Value
             
     With wTA.Range("E3:U3")
         Set rFind = .Find(What:=wTA.Range("B3"), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
             If Not rFind Is Nothing Then
             MsgBox "The Month " & rFind & " is in column " & rFind.Column
             End If
     End With
                
     ' *** Copy Student Monthly Values from Summary to Tutoring Attendance *** Does NOT WORK *** 12 Aug 2021 requesting help from experts ***
     For K = 5 To wTA.Cells(Rows.Count, 2).End(xlUp).Row
        With Application
            wTA.Cells(K, 3).Value = .IfError(.VLookup(wTA.Cells(K, 2), arrSum, 2, False), "")
            wTA.Cells(K, rFind.Column).Value = .IfError(.VLookup(wTA.Cells(K, 2), arrSum, 4, False), "")
            wTA.Cells(K, rFind.Column + 1).Value = .IfError(.VLookup(wTA.Cells(K, 2), arrSum, 5, False), "")
        End With
     Next
    
End Sub

 

[MarqyMarq]

Hi Alex, thank you for all your help with this problem (and it's companion Compare Two Sheets (A and B). Some data NOT copying to Sheet B).

I am going to attempt to merge both sub functions to work together. I have an idea of what needs to be done, so I'll have to play with it a bit.

Thank you again for all your help! Cheers!

 

[Alex Blakenburg]

I am going to attempt to merge both sub functions to work together.

Since the subroutine is pretty much stand alone, you could just put a line in your other code that says:-

Call  CopySummaryMonthlyData_TutoringMonthArea

 

[MarqyMarq]

Hi Alex,

Thanks for the suggestion! It actually works as you suggested using the CALL statement!

I was thinking since I am repeating the same setup (Dim, Set, row count, etc) , I could just merge it and use the same variables. Using a CALL function is much easier!

Thanks for the tip!

Thank you again for all your help! Cheers!

 

[MarqyMarq]

Hi Alex, I know it's late for you!!! so you can answer tomorrow (or afterwards).

The code changes you have recommended have been successful so far.
However, when I protect the sheet so no one can change the template, I get the following error code:

I have not run across this before, so I am at a loss.

I changed the variable "K" to "NewN" thinking it was the "K" in the array that was causing the error. That didn't help.
I removed all the "K" and made them only numbers... that didn't help neither.

I stepped through the code using (F8) and found the line of code (second line) that it has the error in.

wTA.Cells(NewN, rFind.Column).Value = .IfError(.VLookup(wTA.Cells(NewN, 2), arrSum, 4, False), "")
wTA.Cells(NewN, rFind.Column + 1).Value = .IfError(.VLookup(wTA.Cells(NewN, 2), arrSum, 5, False), "")

In comparing the code, the only difference is the "+1" in the second line.... is that the issue?

The code (both sides) works well when the sheet is unprotected. Any Ideas?

Let's tackle this tomorrow (or at your discretion).

Good night Alex!

 

[Alex Blakenburg]

Unless you are writing to an unprotected cell, the code would need to unprotect the sheet first.
Typically when working with a protected sheet your code would unprotect the sheet prior to doing anything in the sheet, and reapply the protection when finished.
Example below:-

Sub test()

    Dim pwd As String
    pwd = "test"
    
    Worksheets("Sheet2").Unprotect Password:=pwd
    
    ' --- Do stuff ---

    Worksheets("Sheet2").Protect Password:=pwd

End Sub

Now I am definitely off to bed.

Goodnight Marqy