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

 

[MarqyMarq]

Good morning Alex,

I did think about doing the unprotect/protect method if all else fails. I'll let you know what I come up with as I keep searching why I am getting the error.

Hope you have a great morning!

 

[Alex Blakenburg]

I am getting a different error.
Which line is it stopping on when you hit debug, when it errors out ?

My error occurs when it is trying to highlight the new name in yellow and is overcome if I allow Format Cells when I protect the sheet.
Oh and that is on the assumption that the cells that the macro is trying to update are set to Unlocked.

 

[MarqyMarq]

Good Morning Alex, coming to you from Oklahoma (USA) on Sunday morning @ 8:10 am!

I think I got mine fixed. Went back to basics: "unlock" every cell and then slowly change the areas surrounding "B5:V43" to the "locked" state. I did recognize when I had the months on row 3 "hidden" that might have been the problem for the "rFind" variable. (Just guessing).

Regardless, with turning everything to "unlock" and then slowing changing the areas, it started to work as designed.

Mine was erroring out on the following line:

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

Here is the code for rFind:

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
                Else
                MsgBox "Please enter a valid month for reporting in Tutoring Attendance", vbCritical, "Opps, Something Went Wrong!"
                Exit Sub
             End If
     End With

I did add the error trap as result of this error! If "rFind" does not find the month in the set range (Sept - May), it shows a MsgBox.
We don't have "summer" school here in elementary schools. (Yes, I know you are in your winter months in Australia,?

Curious, what error were you getting when you ran your code?

Have a good night, Alex!

 

[Alex Blakenburg]

The error I was getting was this and was clearly occurring at the formatting line.
Enabling the allow all users to Format Cells, fixed this.

 

[Alex Blakenburg]

I did recognize when I had the months on row 3 "hidden" that might have been the problem for the "rFind" variable. (Just guessing).

I tested hiding the month on the tutorial sheet (hide row & also hide column) and in neither the unprotected or protected mode did this cause any issue.
I think the month would have to be missing or mispelled for it to cause rFind to return nothing.
The error you were experiencing would more likely be due to the cell you are writing to being locked.

But I would expect you to get the error message below

 

[MarqyMarq]

I tested hiding the month on the tutorial sheet (hide row & also hide column) and in neither the unprotected or protected mode did this cause any issue.
I think the month would have to be missing or mispelled for it to cause rFind to return nothing.
The error you were experiencing would more likely be due to the cell you are writing to being locked.

But I would expect you to get the error message below

View attachment 44897

Hi Alex,

The rFind is based on a LIST field , which has all the months listed. No chance of it being empty or misspelled.

I suspect it was one of my cells being "locked" but I was not seeing it initially. By me "unlocking" all the cells and systematically "locking" the correct cells, I guess I fixed it.

The good news... you were there to help me through this mess! I certainly will be playing arrays more often. I can see the value in doing all the grunt work in memory rather than moving things around in my spreadhseets.

Th error message are getting is quite different than mine. Perhaps its because of the O365 vs 2016 versions.

Thanks again Alex! Cheers my friend!

 

[Alex Blakenburg]

It's been a pleasure. Glad I was able to help.

 

[MarqyMarq]

Alex, Good day my friend!!! Following up as I am wrapping up my little project, I am coming across some minor errors which I am uncertain how to fix.

If you go back to Post #5, you provided a good solution to my initial problem and I implemented the solution. Things are peachy until I start to really look at implementation.

Scenario: If a student leaves our tutoring program, we remove his sheet (Bravo, Taylor-6) from view (HIDE) so it doesn't accidentally get updated. Also, by doing the HIDING, his name does NOT show up on the TABLE OF CONTENTS tab as well (this is good too!).

Objective: Keep the students information including all his tutoring numbers, even if he leaves the program.

PROBLEM: In the TUTORING ATTENDANCE tab, his name and all his tutoring numbers are preserved (good!) from the previous months, but his grade (6) is deleted from the sheet (Bad!).

I see the problem in the following code line, but not sure how to fix it.

Here is the rest of the code:

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 NewN 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
    
     ' *** Looks for current month in Cell B3 and finds column associated 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
                Else
                MsgBox "Tutoring Attendance reporting only valid" & vbNewLine & _
                       "for the months of September through May" & vbNewLine & vbNewLine & _
                       "Please enter a valid month for reporting in Tutoring Attendance", _
                       vbCritical, "Opps, Something Went Wrong!"
                Exit Sub
             End If
     End With
               
    ' *** Copy Student Monthly Values from Summary to Tutoring Attendance - Works!  Thanks Alex Blakenburg (Mr Excel Member)
    For NewN = 5 To wTA.Cells(Rows.Count, 2).End(xlUp).Row
        With Application
            wTA.Cells(NewN, 3).Value = .IfError(.VLookup(wTA.Cells(NewN, 2), arrSum, 2, False), "")
            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), "")
        End With
    Next
   
    ' *** Sort_Tutoring Worksheet
    Range("B5:V44").Select
    wTA.Sort.SortFields.Clear
    wTA.Sort.SortFields.Add2 Key:= _
        Range("B5:B44"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wTA.Sort
            .SetRange Range("B5:V44")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
    End With
    Range("B5").Select
    
End Sub

NOTE: I have an alternative suggestion, but if you have an easy solution, then I'm open to that too.

Do I post the alternate solution in the other post we had been conversing in Compare Two Sheets A and B (Some Data Not Copying to Sheet B) I'm stumped on that side as well.

Compare Two Sheets (A and B): Some data NOT copying to Sheet B

I've have come close to solving my original dilemma: Compare Two Sheets (A and B) and copy & hilight differences to bottom of B NOTE: I did try to use XLS2BB add-in and it locks up my EXCEL program. In breaking down my original problem, I have come to this road block: some data is not...

www.mrexcel.com

 

[Alex Blakenburg]

You have options here.
If you are happy that the grade only needs to be set when a new student gets added then
delete the line you have correctly identified above in the update new month module and
add the 2nd line below to the Module that adds new students.
(the first line is just for context)

             wTA.Range("B" & lastRowTut).Interior.Color = vbYellow
             
             wTA.Range("C" & lastRowTut).Value = ARg(K).Cells.Offset(0, 1).Value

 

[MarqyMarq]

HI Alex! You were in my mind! I deleted the previous line and move the code line where it fit more logically.
The best part about this... your new line and mine are pretty close. Of course, I was copying the previous line, so it was a no brainer!

Thank you again! I have been cleaning up the rest of the code and refining a few other procedures in the larger program. All in all, what I set out to accomplish is... more efficient than my first version of the program.

Thanks to you and a few others (Peter_SSs, Fluff, Mark858), my program is ready to go! Thank you again!