Consulting

Results 1 to 3 of 3

Thread: Using VBA in Excel macro to extract data from table and reconstruct table

  1. #1

    Using VBA in Excel macro to extract data from table and reconstruct table

    Here is an interesting 'real-world' school based problem.


    There are about 250 students in a year group who generally take ten subjects so there are 2500 rows in a table for each year group. Each row includes the subject/class name/teacher name and the studentís target in that subject. I need to be able to export a spreadsheet for each teacher that will enable them to change targets (in a separate column). I need a save option that will enable that teachers spreadsheet to paste into a master sheets basically re-compiling the master with all the teacher changes.


    So, I think the process is:
    - Copy / paste the teacher name column on the table and remove duplicates so that you have a list of all the teachers.
    - For each teacher name in this list:
    o Filter the table to display that teachers student/ subject/ class
    o Copy into a new sheet, a few rows down to allow for some summary formulas and heading to be added
    o Add some formula columns to the right of the table (but with the same number of rows)
    o Give the records (not the headings) a range name identify the teacher
    o Save with a file name that identifies the teacher and year group
    - Provide a separate Save button for the user such that when pressed the records which are part of the table are copied over the records which already exist in the master.


    Thatís the idea.


    I have some spreadsheet of dummy data you can work with if you want to take a closer look
    1. Dummy Data
    2. Example of the data I want to export for one teacher (called Target Review Year 10 Teacher#20)
    3. Example of a reconstructed table (called 3 Recompiled)


    Good luck and all help appreciated
    Attached Files Attached Files
      To view attachments your post count must be 0 or greater. Your post count is 0 momentarily.

  2. #2
    How can I get the revised data from Dummydata book?

  3. #3
    Try this , Note I have commented out saving the workbook because I didn't want loads of workbooks saved on my machine,
    Sub copydata()With Worksheets("Sheet1") 
        Dim teachername As String 
        Dim outarr As Variant 
         ' double quotes string
        tt = Chr(34) 
        teachername = "9999" 
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row 
        inarr = Range(.Cells(1, 1), .Cells(lastrow, 6)) 
    End With 
     
     
    For i = 2 To lastrow 
        If inarr(i, 5) <> "" Then 
            If teachername <> inarr(i, 5) Then 
                If teachername <> "9999" Then 
                    outarr(1, 1) = "Target Review " & inarr(i, 2) & " " & teachername 
                    outarr(3, 1) = "High" 
                    outarr(4, 1) = "Middle" 
                    outarr(5, 1) = "Low" 
                     
                    Range(Cells(1, 1), Cells(lastrow + 7, 6)) = outarr 
                     '=COUNTIFS(G$7:G$1198,">0",A$7:A$1198,A3)
                    Cells(3, 2).Formula = "=countifs(G$7:g$" & indi & "," & tt & ">0" & tt & ",A$7:A$" & indi & ",A3)" 
                    Cells(4, 2).Formula = "=countifs(G$7:g$" & indi & "," & tt & ">0" & tt & ",A$7:A$" & indi & ",A4)" 
                    Cells(5, 2).Formula = "=countifs(G$7:g$" & indi & "," & tt & ">0" & tt & ",A$7:A$" & indi & ",A5)" 
                    Cells(3, 7).Formula = "=countifs(G$7:g$" & indi & "," & tt & ">0" & tt & ")" 
                    Cells(3, 8).Formula = "=Sum(H$7:H$" & indi & ")" 
                    Cells(7, 7) = "Revised" 
                    Cells(7, 8) = "Changed" 
                     
                     '   ActiveWorkbook.SaveAs "C:\tmp\" & teachername & ".xls"
                End If 
                teachername = inarr(i, 5) 
                Workbooks.Add 
                outarr = Range(Cells(1, 1), Cells(lastrow + 7, 6)) 
                For j = 1 To 6 
                     ' copy the headings
                    outarr(7, j) = inarr(1, j) 
                Next j 
                indi = 8 
                 ' copy a line of data
                For j = 1 To 6 
                    outarr(indi, j) = inarr(i, j) 
                Next j 
                 'delete the name because we have done it.
                inarr(i, 5) = "" 
                indi = indi + 1 
            End If 
             ' go and check the rest of the list for the same teacher
            For k = i To lastrow 
                If teachername = inarr(k, 5) Then 
                     ' copy a line of data
                    For j = 1 To 6 
                        outarr(indi, j) = inarr(k, j) 
                    Next j 
                    inarr(k, 5) = "" 
                    indi = indi + 1 
                End If 
            Next k 
        End If 
    Next i 
     
     
    End Sub 
    
    
    Formatting tags added by mark007

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •