Copy Certain Cells to Another Sheet In Correct Row

MarqyMarq

New Member
Joined
Oct 22, 2015
Messages
30
Office Version
  1. 2016
Platform
  1. Windows
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.

1628825172048.png
1628826108293.png


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.

VBA Code:
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
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
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:

VBA 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 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
 
Upvote 0
' *** 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.

1628864952608.png


If you can look at the code and see what needs to be changed, I'd appreciate it.
 
Upvote 0
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.
 
Upvote 0
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.

VBA 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 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
 
Upvote 0
Solution
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!
 
Upvote 0
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:-
VBA Code:
Call  CopySummaryMonthlyData_TutoringMonthArea
 
Upvote 0
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!
 
Upvote 0
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:
1628950680542.png



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.

VBA Code:
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!
 
Upvote 0
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:-

VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,224,822
Messages
6,181,165
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