VBA Code is not copying and pasting properly?

[tombor]

Hi All,

I'm working on creating an attendance spreadsheet between 3 spreadsheets, a 'marker,' a 'database,' and a 'record keeper.'

In the marking worksheet I have the following code which will record and create a unique ID for each attendance marked which will be stored in the Database.

Sub Mark_Monday_Attendance()
        
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    
        Set sh = Workbooks("Attendance Sheet.xlsm").Worksheets("Monday - Mark Attendance")
        Set dsh = Workbooks("Database.xlsm").Worksheets("Database")
        
        Dim r As Integer
        Dim c As Integer
        
        Dim lt As Long
        
        For c = 5 To 10
            For r = 4 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
                If sh.Cells(r, c).Value <> "" Then
                
                    If Application.WorksheetFunction.CountIf(dsh.Range("A:A"), sh.Range("D" & r).Value & "_" & Format(sh.Cells(3, c).Value, 0)) > 0 Then
                        If sh.Range("E1").Value = True Then
                            lr = Application.WorksheetFunction.Match(sh.Range("D" & r).Value & "_" & Format(sh.Cells(3, c).Value, 0), dsh.Range("A:A"), 0)
                            
                            dsh.Range("A" & lr).Value = sh.Range("D" & r).Value & "_" & Format(sh.Cells(3, c).Value, 0)
                            dsh.Range("B" & lr).Value = sh.Range("A" & r).Value
                            dsh.Range("C" & lr).Value = sh.Range("B" & r).Value
                            dsh.Range("D" & lr).Value = sh.Range("C" & r).Value
                            dsh.Range("E" & lr).Value = sh.Range("D" & r).Value
                            dsh.Range("F" & lr).Value = sh.Cells(3, c).Value
                            dsh.Range("G" & lr).Value = sh.Cells(r, c).Value
                            
                        End If
                    Else
                        lr = Application.WorksheetFunction.CountA(dsh.Range("A:A")) + 1
                        
                            dsh.Range("A" & lr).Value = sh.Range("D" & r).Value & "_" & Format(sh.Cells(3, c).Value, 0)
                            dsh.Range("B" & lr).Value = sh.Range("A" & r).Value
                            dsh.Range("C" & lr).Value = sh.Range("B" & r).Value
                            dsh.Range("D" & lr).Value = sh.Range("C" & r).Value
                            dsh.Range("E" & lr).Value = sh.Range("D" & r).Value
                            dsh.Range("F" & lr).Value = sh.Cells(3, c).Value
                            dsh.Range("G" & lr).Value = sh.Cells(r, c).Value
                    End If
                End If
            Next r
        Next c
        
        MsgBox "Attendance has been Marked", vbInformation

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True

End Sub

Code looks fine to me but nothing is populated in the database when I run it. Weirdly enough, my 'record' worksheet uses a vlookup to display reports, and the vlookup works! So the data is being created and stored somewhere, I just can't find where.

 

[rollis13]

No idea what your macro is supposed do to but my dummy-data is copied from sheet 'Monday - Mark Attendance' to sheet 'Database'.
- try using Ctrl+End on sheet 'Database' to find the last used cell, maybe data is pasted far from visible area.
- try without Application.ScreenUpdating = False in your macro.