VBA Code Needed

[nhbartos]

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.

July

Dates of Absence

Fri

Sat

Sun

Mon

Tue

Wed

Thu

Fri

Sat

Sun

Mon

Tue

Wed

Thu

Fri

Sat

Sun

Mon

Tue

Wed

Thu

Fri

Sat

Sun

Mon

Tue

Wed

Thu

Fri

Sat

Sun

Student Name

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

Student 1

Student 2

Student 3

Student 4

Student 5

Student 6

Student 7

Student 8

Student 9

Student 10

Student 11

Student 12

Student 13 Is anyone able to help with this? Vince

<colgroup><col><col span="31"></colgroup><tbody>
</tbody>

 

[nhbartos]

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?

 

[nhbartos]

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.

 

[MickG]

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 !!!

 

[MickG]

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 "****"

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

 

[nhbartos]

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?

	A	B	C	D	E
1	Student Name	Medicaid	Date Of Birth	Admission Date	Discharge Date
2	Student 1
3	Student 2

<tbody>
</tbody>

 

[nhbartos]

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:

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

 

[MickG]

Try this with the "Base Info" sheet and "Pic" sheet
https://app.box.com/s/3sonju3wg3jq68dk2wtl6g3oy2etcg9f

 

[nhbartos]

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?

SICK	EARLY LEAVE	LATE ARRIVAL	VACATION	HALF DAY	LATE IN EARLY OUT
3/1/15	3/15/17	3/15/17	3/15/17	3/15/17
	3/15/17	3/15/17	3/15/17
		3/15/17
		3/15/17
		3/15/17
1	2	5	2	1	0

<tbody>
</tbody>

 

[nhbartos]

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...

 

[nhbartos]

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?

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