Need a macros that read a range of cells, determine low value, then do something else
Hi to everyone.
I need help with this:
I have an excel with four pages (page1,pageB,pageC and pageD), the last 3 pages are empty, and the firstone has this:
A B C D 1 5 3šoption 1šoption 2šoption 2 4 2šoption 3šoption 1šoption 3 3 1šoption 3šoption 2šoption 4 2 1šoption 2šoption 3šoption 5 1 2šoption 1šoption 3šoption
I need this: A VBA code that read the cells from b1 to d1 (completes all the code and then from b2 to d2 and then from b3 to d3 and so on), and determine wich one has the lowest option(1šoption is the lowest, and 3šoption is the highest) and based on which column is the 1šoption, copy the readed row or cells(b1 to d1) and paste it into the page wich has the name of where is the 1option, in the case of the first row, it will be in pageC.
But wait a minute, the number of rows that can be copied within each page is limited. (for example in PageB = 1, PageC = 2 and in PageD = 2)
So it has to do this:
It start from the first row, read cells b1,c1,d1 and determines wich has the lowest option (1šoption) so in this case, the 1šoption is on the column C, so then it copy the row, and past it on PageC. Remember that the max number of rows to be copied into the pages, are limited, so in this case, PageC=2, then now, is = 1.
Ok lest move on, now goes to the second row, and reads b2,c2,d2, make the same as the first row, determines wich and where is the lowest option, in this case is on the column D, so then it copy the row, and past it on PageD. PageD=2, then now is = 1.
Now, goes to the third row, and reads b3,c3,d3, determines wich and where is the lowest option, in this case is on the column B, so then it copy the row, and past it on PageB. PageB=1, then now is = 0. Now, here the limit is full, lets see what happend in the next row.
Now, goes to the fourth row, and reads b4,c4,d4, determines wich and where is the lowest option, in this case is on the column B, but remember that the limit of rows in PageB is full, so it cant be copied into that page, so here goes from low to high, let me explain: The PaceB is full, the row4 cant be copied into her first option (1šoption) so going from low from high, the next should be the second option (2šoption) so now, the second option of the row 4 is on the column C, and in PageC, the original limit was 2, but we allready copied the row 1 in there, so there still one space on PageC. So the row 4 goes to PageC, and now PageC has fulled his limit. PageC original limit=2, but we copied the first and the fourth rows in there.
Now move on to the last row.
Now, goes to the fifth row, and reads b5,c5,d5, determines wich and where is the lowest option, in this case is on the column C, but PageC limit is full, so its takes his second option (2šoption) wich is under the B column, but the PageB limit is also full, so it has to take his third option (3šoption) wich is under the D column. Now, the origianl PageD limit was = 2, but we already copied one row there, the secondone, so it change the limit from 2 to 1. So there still 1 space to copy the fifth row there, so the fifth row will be copied into the PageD.
So the final reult, should look like this:
On pageB is this:
Row 3
On pageC is this:
Row 1
Row 4
On pageD is this:
Row 2
Row 5
I have the following code, but it doest do what i need, but maybe someone can modify it.
Here is the code:
Sub copiar() Dim PageB, PageC, PageD As Integer Dim contador As Integer contador = 1 PageB= 0 PageC= 0 PageD= 0 Do While contador <= 5 Sheets("Page1").Select Select Case Range("B" & contador + 1).Value Case "1šoption" If PageB < 1 Then Range("B" & contador + 1 & ":D" & contador + 1).Select Range("B" & contador + 1 & ":D" & contador + 1).Copy Sheets("PageB").Select Range("A" & PageB+ 1).Select ActiveSheet.Paste PageB= PageB + 1 Else If PageC < 2 Then Range("B" & contador + 1 & ":D" & contador + 1).Select Range("B" & contador + 1 & ":D" & contador + 1).Copy Sheets("PageC").Select Range("A" & PageC + 1).Select ActiveSheet.Paste PageC = PageC + 1 Else If PageC < 2 Then Range("B" & contador + 1 & ":D" & contador + 1).Select Range("B" & contador + 1 & ":D" & contador + 1).Copy Sheets("PageC").Select Range("A" & PageC + 1).Select ActiveSheet.Paste PageC = PageC + 1 Else MsgBox "The limit is full" Exit Do End If End If End If Case "2šoption" If PageC < 2 Then Range("B" & contador + 1 & ":D" & contador + 1).Select Range("B" & contador + 1 & ":D" & contador + 1).Copy Sheets("PageC ").Select Range("A" & PageC + 1).Select ActiveSheet.Paste PageC = PageC + 1 Else If PageB < 1 Then Range("B" & contador + 1 & ":D" & contador + 1).Select Range("B" & contador + 1 & ":D" & contador + 1).Copy Sheets("PageB ").Select Range("A" & PageB + 1).Select ActiveSheet.Paste PageB = PageB + 1 Else If PageD < 2 Then Range("B" & contador + 1 & ":D" & contador + 1).Select Range("B" & contador + 1 & ":D" & contador + 1).Copy Sheets("PageD ").Select Range("A" & PageD + 1).Select ActiveSheet.Paste PageD = PageD + 1 Else MsgBox "The limit is full" Exit Do End If End If End If Case "3šoption" If PageD < 2 Then Range("B" & contador + 1 & ":D" & contador + 1).Select Range("B" & contador + 1 & ":D" & contador + 1).Copy Sheets("PageD ").Select Range("A" & PageD + 1).Select ActiveSheet.Paste PageD = PageD + 1 Else If PageB < 1 Then Range("B" & contador + 1 & ":D" & contador + 1).Select Range("B" & contador + 1 & ":D" & contador + 1).Copy Sheets("PageB ").Select Range("A" & PageB + 1).Select ActiveSheet.Paste PageB = PageB + 1 Else If PageC < 2 Then Range("B" & contador + 1 & ":D" & contador + 1).Select Range("B" & contador + 1 & ":D" & contador + 1).Copy Sheets("PageC ").Select Range("A" & PageC + 1).Select ActiveSheet.Paste PageC = PageC + 1 Else MsgBox "The limit is full" Exit Do End If End If End If End Select contador = contador + 1 Loop End Sub
Reply With Quote
Originally Posted by p45cal
