Solved: Move rows to new sheet based on condition

[Gabba]

I've the below data in the excel file.
I want the rows having student id 521AC, 322UD, 150BD, 333IM, 654UR to be moved to a new sheet (delete the rows from the current sheet) named as Section A in the same file with the same header.
Rename the current sheet as Section B

Column B Column C Col D Col E Col F
Student ID Student Internal External Age
521AC David 20 69 25
322UD John 19 54 23
303AD Rick 17 86 22
212UR Steve 20 70 21
150BD Patrick 19 55 18
187SR Mike 20 99 19
365FD Wright 15 56 20
312OR Richards 15 20 25
333IM Graham 15 97 25
'
'
'
'
'
'
654UR Gardon 14 52 23

[Gabba]

FYI - The specified student id may appear in any row; everyday i receive a report like this in which the student id will appear in random..

[AZIQN]

Hi Gabba, welcome to the forum. You'll find it to be a very helpful place.
Try out the code below. It should accomplish everything you described. You may have to change the "For i = LastRow to 2 step -1" line depending on how many header rows you have above the rows you are moving/deleting. I assumed you only had the one row of column headers, but if you have more, change the "2" to 3, 4, or 5 depending on how many rows you want to leave at the top. Hope that helps.


Sub MoveRows()
Application.ScreenUpdating = False
Dim i As Long
Dim LastRow As Long

ActiveSheet.Name = "Section B"
Sheets("Section B").Copy Before:=Worksheets("Section B")
ActiveSheet.Name = "Section A"
Sheets("Section A").Activate
With ActiveSheet

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = LastRow To 2 Step -1
If .Cells(i, "B").Value <> "521AC" And _
.Cells(i, "B").Value <> "322UD" And _
.Cells(i, "B").Value <> "150BD" And _
.Cells(i, "B").Value <> "333IM" And _
.Cells(i, "B").Value <> "654UR" Then
.Rows(i).Delete
End If
Next i
End With
Sheets("Section B").Activate
With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = LastRow To 2 Step -1
If .Cells(i, "B").Value = "521AC" Or _
.Cells(i, "B").Value = "322UD" Or _
.Cells(i, "B").Value = "150BD" Or _
.Cells(i, "B").Value = "333IM" Or _
.Cells(i, "B").Value = "654UR" Then
.Rows(i).Delete
End If
Next i
End With

End Sub

[Gabba]

Thanks for your efforts. I've an issue.
It just copy the old sheet and create new sheet but the selective student id's are not appearing in the new sheet. The selective student id's are still appearing in the old sheet.

I've attached the excel file, similar to the student data.
I've put the macro codes in the module.
The below S.No. has to be moved to New Zealand sheet and to be deleted from Australia sheet.
Please refer the attached excel.

673BF 674PB 675CA 677EG 678JD 679AH 681MM 682PF 683LH 686CH

Hope you will crack it..

[AZIQN]

Hi Gabba. I found the issue - your data must have been imported as space delimited or something, because there is one trailing space on each of the student IDs. There are a couple ways to fix it - one is to use the TRIM function and remove the spaces, the second is to just adjust the code to accomodate the spaces. I chose the second option, and the code below should accomplish everything - including adding the sums and averages after the data in each sheet. I left the decimals and borders unformatted, so you may wish to add those into the code later. Hope this is what you were looking for...


Sub MoveRows()
Application.ScreenUpdating = False
Dim i As Long
Dim LastRow As Long
Dim TotRows As Long
Dim NZC As Range
Dim NZD As Range
Dim NZE As Range
Dim NZF As Range
Dim AUSC As Range
Dim AUSD As Range
Dim AUSE As Range
Dim AUSF As Range

ActiveSheet.Name = "Australia"
Sheets("Australia").Copy Before:=Worksheets("Australia")
ActiveSheet.Name = "New Zealand"
Sheets("New Zealand").Activate

With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = LastRow To 4 Step -1
If .Cells(i, "B").Value <> "673BF " And _
.Cells(i, "B").Value <> "674PB " And _
.Cells(i, "B").Value <> "675CA " And _
.Cells(i, "B").Value <> "677EG " And _
.Cells(i, "B").Value <> "678JD " And _
.Cells(i, "B").Value <> "679AH " And _
.Cells(i, "B").Value <> "681MM " And _
.Cells(i, "B").Value <> "682PF " And _
.Cells(i, "B").Value <> "683LH " And _
.Cells(i, "B").Value <> "686CH " Then
.Rows(i).Delete
End If
Next i
End With
TotRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("C4:C" & TotRows).Name = "NZC"
Range("D4:D" & TotRows).Name = "NZD"
Range("E4:E" & TotRows).Name = "NZE"
Range("F4:F" & TotRows).Name = "NZF"
Set NZC = Range("C4:C" & TotRows)
Set NZD = Range("D4:D" & TotRows)
Set NZE = Range("E4:E" & TotRows)
Set NZF = Range("F4:F" & TotRows)

Range("B" & TotRows + 1).Activate
ActiveCell.Value = "Total ="
ActiveCell.Offset(0, 1).Value = "=SUM(NZC)"
ActiveCell.Offset(0, 2).Value = "=AVERAGE(NZD)"
ActiveCell.Offset(0, 3).Value = "=SUM(NZE)"
ActiveCell.Offset(0, 4).Value = "=AVERAGE(NZF)"


Sheets("Australia").Activate
With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = LastRow To 4 Step -1
If .Cells(i, "B").Value = "673BF " Or _
.Cells(i, "B").Value = "674PB " Or _
.Cells(i, "B").Value = "675CA " Or _
.Cells(i, "B").Value = "677EG " Or _
.Cells(i, "B").Value = "678JD " Or _
.Cells(i, "B").Value = "679AH " Or _
.Cells(i, "B").Value = "681MM " Or _
.Cells(i, "B").Value = "682PF " Or _
.Cells(i, "B").Value = "683LH " Or _
.Cells(i, "B").Value = "686CH " Then
.Rows(i).Delete
End If
Next i
End With
TotRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("C4:C" & TotRows).Name = "AUSC"
Range("D4:D" & TotRows).Name = "AUSD"
Range("E4:E" & TotRows).Name = "AUSE"
Range("F4:F" & TotRows).Name = "AUSF"
Set AUSC = Range("C4:C" & TotRows)
Set AUSD = Range("D4:D" & TotRows)
Set AUSE = Range("E4:E" & TotRows)
Set AUSF = Range("F4:F" & TotRows)

Range("B" & TotRows + 1).Activate
ActiveCell.Value = "Total ="
ActiveCell.Offset(0, 1).Value = "=SUM(AUSC)"
ActiveCell.Offset(0, 2).Value = "=AVERAGE(AUSD)"
ActiveCell.Offset(0, 3).Value = "=SUM(AUSE)"
ActiveCell.Offset(0, 4).Value = "=AVERAGE(AUSF)"

End Sub

[Gabba]

Hi,
This works great. Awesome. Thanks a lot.

[Gabba]

Hi,
I've two issues in this.Total value in row 84 calculates the total values in row 80. Typically, it should calculate the sum / average only for the rows having user ids.

Similarly, the sum/average values in Newzealand sheet (newly creates sheet) are just replicating the values of the total value calculated in Australia sheet. It should be the sum / average of the values present in the sheet.

Thanks for your help.

[AZIQN]

I'm having trouble replicating your problem with the Test Macro file you uploaded previously. Everything seems to work just fine. As far as the totals in Row 80...didn't you just include that highlighted portion for my understanding of what you were trying to accomplish? We are automatically calculating totals to replace those, so you should delete those lines prior to running the macro...When I run the macro, the New Zealand and Australia totals are NOT the same...check your sheet.

[Gabba]

Both are not same but the total sum & average calculated in the Australia sheet (Refer row 74 in the sample output file attached) was including the total sum & average given in row 70.

The row 70 was the total sum & average of old sheet containing both Aus & NZ codes.

As we split the sheets based on S.No, the sum & average values should be calculated based on the current data present in the sheet.

We need to assign a shortcut key to execute this macro as the user will receive similar kind of excel file daily and just by pressing the shortcut key, this macro has to be executed.

Hope my requirements are clear.

[Gabba]

Hi,
I've two sheets (Daily, Monthly) with few more columns added - Now, considering my above requirements, the reports have to be splitted into NZ, Ausralia for Daily and Monthly (total 4 reports to be created)

The above two sheets are generated from the tool and please help me to create the macros. The format of the report will be the same for all days and months.

Can you also help me with this?

[Gabba]

Can you help me?