VBA help for autosorting rows, moving blank function rows to bottom (not delete), & consolidating 4 sheets to another sheet

Jason Chan

New Member
Joined
Jul 17, 2015
Messages
27
I run a tuition center and at the moment, I only have 10 students. The center offers three subjects only - ENGLISH, MATH and HISTORY. Scores are aggregated by test components, there are total of seven components in my center. Each subject utilizes a portion of the test components which accords scores for every test taken to each student (ENG – 4 comps, MATH – 4 comps, HIST – 2 comps). The three subjects share one to two test components so some components are retaken with altered questions. All students enroll into ENG, but not all students enroll into MATH and HIST.

SHEET1 is the manual main tests data entry worksheet and has about twenty columns covering all components scores for all ENG, MATH. HIST. SHEET2 is the voluntary work from students’ own practical work which do not add to their overall scores, but provide a reference for my end of semester award. I have to manually enter each student’s scores in all ENG, MATH and HIST components test scores into SHEET1 after every test I give them, as well as SHEET2 after some of them offer to get together to form smaller voluntary projects.

Then, I create SHEETS 3,4,5 to automatically populate with a simple =IF(…,ELSE,””) function pasting them into rows 1 to 1000 in each of these three sheets 3,4,5 (1000 is the temporary number of rows that I estimate my tuition may grow to need for the foreseeable years). SHEET3, SHEET4 and SHEET5 are for auto-populating from SHEET1, filling only rows who meet certain criteria. I do not plan to manually enter anything into SHEETs 3,4,5. After they self-populate every time, my 1st problem is, I need each sheets 3,4,5 to all be instantly auto-sorted ascendingly by the date column in column C, all rows consolidated (no blank rows in-between the 1st and last filled rows) and rows that although look blank but with function to automatically go beneath the last filled row, but not eliminating or deleting those blanks with functions.

Finally, comes SHEET6, which is my 2nd problem, I need to automatically populate continuously by consolidating and merging ALL rows from SHEETs 2,3,4,5 via VBA, then continuously auto-sorting all these rows on SHEET6 whenever a new entry is made in SHEET1 or SHEET2, sorted by the students’ ID in column B. So, the total no.of rows in SHEET6 would be the total combined of all rows in SHEETs 2,3,4,5.

Sadly, I have tried some depressing attempts on my own and a couple of assisted ones, but none have really helped me. For instance, I tried a code to sort the auto-populate sheets, but my function rows that are still blank, all get sorted to the top, while still showing blank. Some people offered me codes, but those codes delete my functions rows that return blanks. I don't want those blanks deleted. I need the filled function rows that are despite not populated, to just be sorted to the bottom, while the filled names and scores rows to the top. And, I have not gotten any help so far for sorting & consolidating the auto-populated sheets to SHEET6 yet. I’m not VBA fluent. I will appreciate if there are any kind expert out here who could help me with a VBA code to complete the above requests for my SHEETs 3,4,5,6?

I have created a cropped miniature sample workbook (of my actual workbook) but I can't find any location here to upload. Please let me know if needed and how to show you.


Waiting for the kind expert at my center,
Jason .
 
Jason Chan,

Your link is asking me to Sign in to continue to Google Drive.

The following is a free site:

You can upload your workbook to (the BLUE link-->) Box Net ,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.


If you are not able to use BOX, then:

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Hiker95,

here it is, at BOX.NET
https://app.box.com/s/80rnkldzsu677vwoug4u8e0nh6cue4a9

Let me know right away if you cannot see the file,

Jason.


Jason Chan,

Your link is asking me to Sign in to continue to Google Drive.

The following is a free site:

You can upload your workbook to (the BLUE link-->) Box Net ,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.


If you are not able to use BOX, then:

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.
 
Upvote 0
Jason Chan,

Thanks for the workbook/worksheets.

I can not see the logic to solve your request.

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.
 
Upvote 0
Hi Jason,

you could start with code like this, it transfers the data. What you'll need is to add an extra column in your 6-resultsheet, so you can sort by the first 4 columns. The other sheets would need a transfer in the same way.
Hope this gets you started.

Cheers,

Koen

Code:
Sub TransferData()

Set Sht3 = Worksheets("3")
Set ShtRes = Worksheets("Result")

ShtRes.Cells.ClearContents

ResRw = 3
For Rw = 2 To 1000
    If Sht3.Range("I" & Rw).Value > 0 Then
        'Marks, process
        Sht3.Range("A" & Rw & ":C" & Rw).Copy
        ShtRes.Range("A" & ResRw).PasteSpecial xlValues
        Sht3.Range("D" & Rw).Value = "ENG"
        Sht3.Range("D" & Rw & ":G" & Rw).Copy
        ShtRes.Range("E" & ResRw).PasteSpecial xlValues
        Sht3.Range("H" & Rw & ":J" & Rw).Copy
        ShtRes.Range("O" & ResRw).PasteSpecial xlValues
        ResRw = ResRw + 1
    Else
    End If
Next Rw

End Sub
 
Upvote 0
Koen,
glad to receive your code, & tried it. Found it created an anomaly in that it created a column of ENG and it WROTE on sheet3 too, modifying the original data with endless column of ENG, so I removed that line in the code. Pls have a look:

Sub TransferData3()

Set Sht3 = Worksheets("3")
Set ShtRes = Worksheets("Result")

ShtRes.Cells.ClearContents

ResRw = 3
For Rw = 2 To 1000
If Sht3.Range("B" & Rw).Value <> "" Then
'Marks, process
Sht3.Range("A" & Rw & ":C" & Rw).Copy
ShtRes.Range("A" & ResRw).PasteSpecial xlValues
Sht3.Range("D" & Rw & ":G" & Rw).Copy
ShtRes.Range("E" & ResRw).PasteSpecial xlValues
Sht3.Range("H" & Rw & ":J" & Rw).Copy
ShtRes.Range("O" & ResRw).PasteSpecial xlValues
ResRw = ResRw + 1
Else
End If
Next Rw

End Sub


a) i renamed the code;
b) i needed all rows that are with even 1 value in the Sheet RESULT so I tweaked to <>"";
c) now, how can i incorporate the code also for the other two sheets? I tried repeating this code in the same RESULT sheet after one another below,

Sub TransferData3()

Set Sht3 = Worksheets("3")
Set ShtRes = Worksheets("Result")

ShtRes.Cells.ClearContents

ResRw = 1
For Rw = 2 To 1000
If Sht3.Range("B" & Rw).Value <> "" Then
'Marks, process
Sht3.Range("A" & Rw & ":C" & Rw).Copy
ShtRes.Range("A" & ResRw).PasteSpecial xlValues
Sht3.Range("D" & Rw & ":G" & Rw).Copy
ShtRes.Range("E" & ResRw).PasteSpecial xlValues
Sht3.Range("H" & Rw & ":J" & Rw).Copy
ShtRes.Range("O" & ResRw).PasteSpecial xlValues
ResRw = ResRw + 1
Else
End If
Next Rw

End Sub
______________________________________

Sub TransferData4()

Set Sht3 = Worksheets("4")
Set ShtRes = Worksheets("Result")

ShtRes.Cells.ClearContents

ResRw = 1
For Rw = 2 To 1000
If Sht3.Range("B" & Rw).Value <> "" Then
'Marks, process
Sht4.Range("A" & Rw & ":C" & Rw).Copy
ShtRes.Range("A" & ResRw).PasteSpecial xlValues
Sht4.Range("D" & Rw & ":G" & Rw).Copy
ShtRes.Range("E" & ResRw).PasteSpecial xlValues
ResRw = ResRw + 1
Else
End If
Next Rw

End Sub
____________________________________________
Sub TransferData5()

Set Sht5 = Worksheets("3")
Set ShtRes = Worksheets("Result")

ShtRes.Cells.ClearContents

ResRw = 1
For Rw = 2 To 1000
If Sht3.Range("B" & Rw).Value <> "" Then
'Marks, process
Sht5.Range("A" & Rw & ":C" & Rw).Copy
ShtRes.Range("A" & ResRw).PasteSpecial xlValues
Sht5.Range("D" & Rw & ":E" & Rw).Copy
ShtRes.Range("E" & ResRw).PasteSpecial xlValues
ResRw = ResRw + 1
Else
End If
Next Rw

End Sub


but when i click on the RUN macro button, EXCEL would ask me which macro to run. Everytime I select either one code to run, the sheet RESULT will only run for ONE of the 3/4/5 origin sheet, not all simultaneously which i need. ALL 3 sheets need to be inside the RESULTS.

Any solution to this ? What have I fail to do, or wrongly do?

Jason


Hi Jason,

you could start with code like this, it transfers the data. What you'll need is to add an extra column in your 6-resultsheet, so you can sort by the first 4 columns. The other sheets would need a transfer in the same way.
Hope this gets you started.

Cheers,

Koen

Code:
Sub TransferData()

Set Sht3 = Worksheets("3")
Set ShtRes = Worksheets("Result")

ShtRes.Cells.ClearContents

ResRw = 3
For Rw = 2 To 1000
    If Sht3.Range("I" & Rw).Value > 0 Then
        'Marks, process
        Sht3.Range("A" & Rw & ":C" & Rw).Copy
        ShtRes.Range("A" & ResRw).PasteSpecial xlValues
        Sht3.Range("D" & Rw).Value = "ENG"
        Sht3.Range("D" & Rw & ":G" & Rw).Copy
        ShtRes.Range("E" & ResRw).PasteSpecial xlValues
        Sht3.Range("H" & Rw & ":J" & Rw).Copy
        ShtRes.Range("O" & ResRw).PasteSpecial xlValues
        ResRw = ResRw + 1
    Else
    End If
Next Rw

End Sub
 
Upvote 0
Hey Jason,

you're making some mistakes in your VBA code. Step 1: try to understand what every line of code does... I threw in some comments (starting with a ' ), hopefully that helps to spot the logic to solve your problem.
Step 2: Some general tips for working with VBA: for macro development, do the following; go to the VBA screen (ALT+F11) and
-in the VBA screen, do open the "view->Locals window" and the "view->immediate window"
-put break points in the code at places where you want it to stop (F9 or click in front of the line, line becomes dark red with a circle in front of it)
-if you then run the code (F5), the code will stop at that point and the locals window will give you insights into what the variables are/have in them
-use F8 to go step by step through your code and hover over variables to see what values they hold.

Hope that helps,

Cheers,

Koen


Code:
Sub TransferData()

Set Sht3 = Worksheets("3")
Set ShtRes = Worksheets("Result")
'Set two variables that you can use through the macro. The first one is referring to the sheet named "3", the second one to a sheet named "result", add a many as you like, e.g.:
Set Sht4 = Worksheets("4")
'etc...

ShtRes.Cells.ClearContents
'Clean the result sheet, remove all contents from that sheet. You only want to do this in the beginning of your macro and then run through the worksheets

ResRw = 3
'The row for the first result

For Rw = 2 To 1000
    'Loop from 2 to 1000, step 1
    If Sht3.Range("I" & Rw).Value > 0 Then
        'If the number in the sheet named "3", column I on the row is greater then 0, then copy paste...
        'Marks, process
        Sht3.Range("A" & Rw & ":C" & Rw).Copy
        ShtRes.Range("A" & ResRw).PasteSpecial xlValues
        Sht3.Range("D" & Rw).Value = "ENG"
        Sht3.Range("D" & Rw & ":G" & Rw).Copy
        ShtRes.Range("E" & ResRw).PasteSpecial xlValues
        Sht3.Range("H" & Rw & ":J" & Rw).Copy
        ShtRes.Range("O" & ResRw).PasteSpecial xlValues
        ResRw = ResRw + 1
    Else
    End If
Next Rw

'This would be the place to do the same for Sht4, Sht5 or whatever sheet you want to run through.

End Sub
 
Upvote 0
hI Koen,

your guidance is wonderful, it's improved this time.

But, how can i get the RESULT sheet to be automatically autosorted everytime? by ID, and then by DATE.

Can you teach me the code for that? & where should i incorporate it into the existing body of code?

Jason


Hey Jason,

you're making some mistakes in your VBA code. Step 1: try to understand what every line of code does... I threw in some comments (starting with a ' ), hopefully that helps to spot the logic to solve your problem.
Step 2: Some general tips for working with VBA: for macro development, do the following; go to the VBA screen (ALT+F11) and
-in the VBA screen, do open the "view->Locals window" and the "view->immediate window"
-put break points in the code at places where you want it to stop (F9 or click in front of the line, line becomes dark red with a circle in front of it)
-if you then run the code (F5), the code will stop at that point and the locals window will give you insights into what the variables are/have in them
-use F8 to go step by step through your code and hover over variables to see what values they hold.

Hope that helps,

Cheers,

Koen


Code:
Sub TransferData()

Set Sht3 = Worksheets("3")
Set ShtRes = Worksheets("Result")
'Set two variables that you can use through the macro. The first one is referring to the sheet named "3", the second one to a sheet named "result", add a many as you like, e.g.:
Set Sht4 = Worksheets("4")
'etc...

ShtRes.Cells.ClearContents
'Clean the result sheet, remove all contents from that sheet. You only want to do this in the beginning of your macro and then run through the worksheets

ResRw = 3
'The row for the first result

For Rw = 2 To 1000
    'Loop from 2 to 1000, step 1
    If Sht3.Range("I" & Rw).Value > 0 Then
        'If the number in the sheet named "3", column I on the row is greater then 0, then copy paste...
        'Marks, process
        Sht3.Range("A" & Rw & ":C" & Rw).Copy
        ShtRes.Range("A" & ResRw).PasteSpecial xlValues
        Sht3.Range("D" & Rw).Value = "ENG"
        Sht3.Range("D" & Rw & ":G" & Rw).Copy
        ShtRes.Range("E" & ResRw).PasteSpecial xlValues
        Sht3.Range("H" & Rw & ":J" & Rw).Copy
        ShtRes.Range("O" & ResRw).PasteSpecial xlValues
        ResRw = ResRw + 1
    Else
    End If
Next Rw

'This would be the place to do the same for Sht4, Sht5 or whatever sheet you want to run through.

End Sub
 
Upvote 0
hey Koen

pthe code doesn't seem to autorun when I enter new data into the main datasheets, is there a way to program the RESULT sheet to instantly run the code by refrshing itself everytime a change is detected in any of the datasheets?

Jason.

Hey Jason,

you're making some mistakes in your VBA code. Step 1: try to understand what every line of code does... I threw in some comments (starting with a ' ), hopefully that helps to spot the logic to solve your problem.
Step 2: Some general tips for working with VBA: for macro development, do the following; go to the VBA screen (ALT+F11) and
-in the VBA screen, do open the "view->Locals window" and the "view->immediate window"
-put break points in the code at places where you want it to stop (F9 or click in front of the line, line becomes dark red with a circle in front of it)
-if you then run the code (F5), the code will stop at that point and the locals window will give you insights into what the variables are/have in them
-use F8 to go step by step through your code and hover over variables to see what values they hold.

Hope that helps,

Cheers,

Koen


Code:
Sub TransferData()

Set Sht3 = Worksheets("3")
Set ShtRes = Worksheets("Result")
'Set two variables that you can use through the macro. The first one is referring to the sheet named "3", the second one to a sheet named "result", add a many as you like, e.g.:
Set Sht4 = Worksheets("4")
'etc...

ShtRes.Cells.ClearContents
'Clean the result sheet, remove all contents from that sheet. You only want to do this in the beginning of your macro and then run through the worksheets

ResRw = 3
'The row for the first result

For Rw = 2 To 1000
    'Loop from 2 to 1000, step 1
    If Sht3.Range("I" & Rw).Value > 0 Then
        'If the number in the sheet named "3", column I on the row is greater then 0, then copy paste...
        'Marks, process
        Sht3.Range("A" & Rw & ":C" & Rw).Copy
        ShtRes.Range("A" & ResRw).PasteSpecial xlValues
        Sht3.Range("D" & Rw).Value = "ENG"
        Sht3.Range("D" & Rw & ":G" & Rw).Copy
        ShtRes.Range("E" & ResRw).PasteSpecial xlValues
        Sht3.Range("H" & Rw & ":J" & Rw).Copy
        ShtRes.Range("O" & ResRw).PasteSpecial xlValues
        ResRw = ResRw + 1
    Else
    End If
Next Rw

'This would be the place to do the same for Sht4, Sht5 or whatever sheet you want to run through.

End Sub
 
Upvote 0
Hi Jason,

normally code won't auto-run. Code is generally located in Modules and triggered by a button. What you could do is link the code to the activation of the worksheet with the totals. But you wouldn't want to let this macro run everytime you change the contents of a cell, that would make it near impossible to work with that workbook.
So how to link it to the activation of the sheet? -> if you go to VBA (ALT+F11), you'll notice that there are basically 3 different places for a macro:
-in a sheet-object
-in the workbook-object
-in a module
Best practice is to put most of your code in modules and as little as possible in the other 2. If you select your summary-sheet in VBA, there should be 2 dropdown boxes at the top, select "worksheet" in the left and "activate" at the right and Excel/VBA will create a block like so:

Code:
Private Sub Worksheet_Activate()

If MsgBox("Are you sure?", vbYesNo) <> vbYes Then
    Exit Sub
End If

Call YourMacroName

End Sub

I added a bit in the middle, which shows a popup-box, so you can choose whether you want to run the macro or not.

Hope that helps,

Koen
 
Upvote 0

Forum statistics

Threads
1,223,912
Messages
6,175,340
Members
452,638
Latest member
Oluwabukunmi

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