VBA Code is not copying and pasting properly?

tombor

New Member
Joined
Jun 9, 2022
Messages
1
Office Version
  1. 365
Platform
  1. Windows
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.

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

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
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.
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

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