VBA Code Needed

N

nhbartos

Board Regular
Joined
May 23, 2015
Messages
148
Hi folks,

I have a table to track Personal, sick, vacation and half days taken for 25 to 150 students.
They are recorded by placing an "S", "P", "V", or an "H" in the cells for the corresponding date.
There is a different tab for each month.
School year July 1 2016 to June 30 2017.

I would like some code to pull the dates for all category entries, for each month, then place them in a table within each students reporting tab and sorted by date.
Below is a partial July 2016 table.
[TABLE="width: 1011"]
<colgroup><col><col span="31"></colgroup><tbody>[TR]
[TD]July[/TD]
[TD="colspan: 31"]Dates of Absence[/TD]
[/TR]
[TR]
[TD]Fri[/TD]
[TD]Sat[/TD]
[TD]Sun[/TD]
[TD]Mon[/TD]
[TD]Tue[/TD]
[TD]Wed[/TD]
[TD]Thu[/TD]
[TD]Fri[/TD]
[TD]Sat[/TD]
[TD]Sun[/TD]
[TD]Mon[/TD]
[TD]Tue[/TD]
[TD]Wed[/TD]
[TD]Thu[/TD]
[TD]Fri[/TD]
[TD]Sat[/TD]
[TD]Sun[/TD]
[TD]Mon[/TD]
[TD]Tue[/TD]
[TD]Wed[/TD]
[TD]Thu[/TD]
[TD]Fri[/TD]
[TD]Sat[/TD]
[TD]Sun[/TD]
[TD]Mon[/TD]
[TD]Tue[/TD]
[TD]Wed[/TD]
[TD]Thu[/TD]
[TD]Fri[/TD]
[TD]Sat[/TD]
[TD]Sun[/TD]
[/TR]
[TR]
[TD]Student Name[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]8[/TD]
[TD]9[/TD]
[TD]10[/TD]
[TD]11[/TD]
[TD]12[/TD]
[TD]13[/TD]
[TD]14[/TD]
[TD]15[/TD]
[TD]16[/TD]
[TD]17[/TD]
[TD]18[/TD]
[TD]19[/TD]
[TD]20[/TD]
[TD]21[/TD]
[TD]22[/TD]
[TD]23[/TD]
[TD]24[/TD]
[TD]25[/TD]
[TD]26[/TD]
[TD]27[/TD]
[TD]28[/TD]
[TD]29[/TD]
[TD]30[/TD]
[TD]31[/TD]
[/TR]
[TR]
[TD]Student 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 8[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 9[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 10[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 11[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 12[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Student 13

Is anyone able to help with this?

Vince[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
Ok, it seems to be working, but now I need to add it to my file.

In the file I am working on, I have several VBA projects listed with various spreadsheets revisions, including the Module 1 test I no longer need.
I was able to delete all modules, but no excel objects or the projects themselves.

I tried to delete them all by saving it as a .XLSX, not a Macro.

There is no delete option on right click or anywhere else.

Any ideas how I can delete all existing code, so I can paste in the latest and greatest?
 
Upvote 0

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
I figured it out somehow...
All is working fine now and I will continue to test and get back to you!
Thank you!

I do have a quick question...

The logo image...
This file may move from PC to PC depending on who may be using the file.
I assume the logo location address would need to be updated for every user and a logo placed in each individual PC.
Is this correct?

If so, this may not work. Is there a way around this or do I just have to not use a logo?

I don't want to lose the logo.
 
Upvote 0
Remove modules:-
In your file Click "Alt + F11" to show vbwindow, In VbWindow click "Ctrl + R" to show "Project window on left.(if not showing)
Scroll down Project window looking for modules,
Any modules not wanted , Right click select "Remove module" (No to export")

Add modules:-
In Vbwindow, select from code window toolbar "Insert" , "Module", new module and code window appears, Paste your new code into that window.
If you've saves as ".XLSX" you will need to resave as ".XLSM"

Try running the code from the sheet Buttons !!!
'##################
Update:-
You could store the "LOGO" in one of the sheets in the file and access it from there.
I would need to alter the code, let me know !!!
 
Last edited:
Upvote 0
Change the "****" sub to the code below:-
You need to store the Picture in a sheet called "Pic", Just copy and paste at top of sheet
Check that its name (Right click the picture, look in "Name Box" top left of screen) is the same as code "Picture 2" (change in code accordingly)
NB:- The sub name is "s Pic" without the space, The forum replaces the name with "****"
Code: 
Sub ****(sht As Object)
Dim Pic As Picture, Fd As Boolean, nPic As Shape
For Each Pic In sht.Pictures
    Fd = True
Next Pic
If Not Fd Then
    Application.ScreenUpdating = False
    Set nPic = Sheets("Pic").Shapes("Picture 2")'Check name here !!!
    nPic.Copy
    With sht.Range("A1")
        .PasteSpecial
        nPic.Top = .Top ' NB The Object is "Pic" not Picture !!
        nPic.Left = .Left
        'Pic.LockAspectRatio = msoTrue ' I found when this was Locked I could not change the Picture size !!!
        nPic.Height = 80
    End With
    Application.ScreenUpdating = True
Else
    Exit Sub
End If
End Sub
 
Last edited:
Upvote 0
Great!
So far so good.

If you don't mind placing the logo in the file I would appreciate it.

The next thing that I have been trying to figure out, is this:

The below table is on a new tab, the 1st tab, named "Base Info".

It will contain this information for all students, max of 125.

On the student reports, B13, you have the kids name auto pop the student name cell.

Can we change that?

I would like the student reports B13:B17 to pull the the data from the table on the "Base Info" Tab.

What do you think?


[TABLE="width: 500, align: left"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Student Name[/TD]
[TD]Medicaid[/TD]
[TD]Date Of Birth[/TD]
[TD]Admission Date[/TD]
[TD]Discharge Date[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Student 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Student 2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
I got you as far as the sub name. I can't get it to work.


I entered:

Sub s pic(sht As Object)

Got a compile error. Syntax error.



I entered:

Sub ****(sht As Object)

Got a compile error. Ambiguous name detected.

Update won't work from the sheets.


I pasted in this replacement code:

Code: 
Sub s pic(sht As Object)Dim Pic As Picture, Fd As Boolean, nPic As Shape
For Each Pic In sht.Pictures
    Fd = True
Next Pic
If Not Fd Then
    Application.ScreenUpdating = False
    Set nPic = Sheets("Pic").Shapes("picture 4") 'Check name here !!!
    nPic.Copy
    With sht.Range("A1")
        .PasteSpecial
        nPic.Top = .Top ' NB The Object is "Pic" not Picture !!
        nPic.Left = .Left
        'Pic.LockAspectRatio = msoTrue ' I found when this was Locked I could not change the Picture size !!!
        nPic.Height = 80
    End With
    Application.ScreenUpdating = True
Else
    Exit Sub
End If
End Sub
 
Upvote 0
Good, very good! Thanks a lot!

We are so close to wrapping this up.

Couple final things...

1. We need column F to be included in the printed page: Portrait

Options???
We can set right and left margins to .5.
We can WRAP and center text in row 19. That might bring things in enough so F is included.

I looked for code to wrap and center the headers in row 19, but none worked.

2. Can we add a CountA total to the bottom of each column?

At the bottom of the column with the most dates, so all the totals are in the same row with a top border to break it up?

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD="align: center"]SICK[/TD]
[TD="align: center"]EARLY LEAVE[/TD]
[TD="align: center"]LATE ARRIVAL[/TD]
[TD="align: center"]VACATION[/TD]
[TD="align: center"]HALF DAY[/TD]
[TD="align: center"]LATE IN EARLY OUT[/TD]
[/TR]
[TR]
[TD="align: center"]3/1/15[/TD]
[TD="align: center"]3/15/17[/TD]
[TD="align: center"]3/15/17
[/TD]
[TD="align: center"]3/15/17[/TD]
[TD="align: center"]3/15/17[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]3/15/17[/TD]
[TD="align: center"]3/15/17[/TD]
[TD="align: center"]3/15/17[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]3/15/17[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]3/15/17[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]3/15/17[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]5[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]0[/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
I trimmed the columns to get column F in the print area. All set with that.

How about the counts at the bottom?

Thanks again...
 
Upvote 0
I decided to merge these cells so I can trim column A down a little more.

A13:B13
A14:B14
A15:B15
A16:B16
A17:B17

I entered the following code additions.
The merges for 13 - 16 worked well.

When I entered the merge code for 17, I got an error message for EVERY sheet when I hit update.
I had to click 100+ error messages get the code to finish running.

It is the same code as the others ones so I am confused/
The A17:b17 merge code merges A13:B17 into one big merge with only the Student Name showing in the box.

This is the code from that section. Any ideas?


Code: 
Dim nNam As Range   With Sheets(K)
    Set nNam = Studata(K)
    .Range("A15").Resize(500, 100).ClearContents
    .Range("c13") = K ' This is Student Name, remove if not wanted
    .Range("A7") = Format(Now, "MMMM,d,yyyy")
    .Range("A10").Value = "Student Attendance Record"
    .Range("A10:B10").Merge
    .Range("A7:B7").Merge
    .Range("A7").Font.Size = 16
    .Range("A7").Font.Bold = True
    .Range("A13").Value = "Student Name:"
    .Range("A13:B13").Merge
    
    .Range("A14").Value = "Medicaid:"
    'MsgBox CDate(nNam.Offset(, 2))
    .Range("A14:B14").Merge
    .Range("c14").Value = IIf(CDate(nNam.Offset(, 2)) = "00:00:00", "N/A", CDate(nNam.Offset(, 2)))
    
    .Range("A15").Value = "Date of Birth:"
    'MsgBox CDate(nNam.Offset(, 2))
    .Range("A15:B15").Merge
    .Range("c15").Value = IIf(CDate(nNam.Offset(, 2)) = "00:00:00", "", CDate(nNam.Offset(, 2)))
    
    .Range("A16").Value = "Admission Date:"
    .Range("A16:B16").Merge
    .Range("c16").Value = IIf(CDate(nNam.Offset(, 3)) = "00:00:00", "", CDate(nNam.Offset(, 3)))
    
    .Range("A17").Value = "Discharge Date:"
    .Range("A17:B17").Merge
    .Range("c17").Value = IIf(CDate(nNam.Offset(, 4)) = "00:00:00", "", CDate(nNam.Offset(, 4)))
        
    .Range("A7:b17").Font.Size = 12
    .Range("A7").Font.Bold = True
    .Range("A13:A17").HorizontalAlignment = xlLeft
    .Range("c13").HorizontalAlignment = xlLeft
    .Range("A7").HorizontalAlignment = xlLeft
    .Range("A19:f19").Font.Bold = True
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

zoharb
  • Question Question
networkdays.intl in excel 2007
Replies
2
Views
283
MARK858
MARK858
F
  • Solved
How to change value from data validation based on value in col A?
Replies
5
Views
330
Eric W
Eric W
D
  • Question Question
Count days at work that were fridays
Replies
3
Views
112
Dave Patton
D
J
  • Solved
Formula Filled Dates
Replies
4
Views
477
Fluff
Fluff
K
  • Question Question
Advice on Data Set up to Chart for Ongoing Daily Metrics
Replies
0
Views
170
Kolchak74
K

Forum statistics

Threads
1,223,723
Messages
6,174,122
Members
452,545
Latest member
boybenqn

Share this page

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