Need every 3 rows to have row 2 and 3 appended to end of row 1

kmw875

New Member
Joined
Sep 29, 2014
Messages
19
Hello Excel Helpers,

I am new to the forum and fairly new to VBA in general. I record most macros which I use. This one however is a bit more tricky and I need some expert help.

I have a spreadsheet of patient accounting which we get regularly from a client. I have a sample mock sheet that I can submit just for a visual to help explain what I need. But the sheet comes in the same format each time only the data changes, the first 3 rows are the headings. Each records is 3 rows long. Headings are from A1 to Q3. Some of the cells are merged but I still need them to copy exactly as is.

The problem I have is that I have to filter out all patients records who have a code of "9MK" in Column N. I thought the easiest way would be to convert all three rows to one long row and then filter on that specific column instead of staff going through and deleting the rows manually for the records that do not have 9MK. Trying to figure out how to attach file with code that I have. Any suggestion is truly appreciated.

Thank you, Kim
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

ProfessorPorcupine

Board Regular
Joined
Sep 20, 2014
Messages
73
Try this, it loops through each three lines looking for if the code is not 9MK. You have to loop upwards since you are deleting rows.

Sub DeleteExcessRecords()
'Deletes records that are not designated "9MK"
Dim wksData As Worksheet
Dim lngCounter As Long
Dim lngFinalRow As Long

Set wksData = ThisWorkbook.Sheets(1)
wksData.Activate
lngFinalRow = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 14).End(xlUp).Row
For lngCounter = lngFinalRow - 2 To 4 Step -3
If wksData.Cells(lngCounter, 14) <> "9MK" Then
wksData.Rows(lngCounter + 2).Delete
wksData.Rows(lngCounter + 1).Delete
wksData.Rows(lngCounter).Delete
End If
Next
End Sub
 

kmw875

New Member
Joined
Sep 29, 2014
Messages
19
Thank you very much for trying to help me! The code for 9MK is in column N and would be in the 2nd row of each account if it exists. I have a small set of sample data I tested your code on. 27 rows, first 3 are the header rows. The code deleted every row other then the 3 top/header rows. I have 7 test accounts, of which 3 have 9MK as the test data, but those did not remain.
 

ProfessorPorcupine

Board Regular
Joined
Sep 20, 2014
Messages
73
Since the code for 9MK is in the second row of each account and not the first, you just need to make a small adjustment as below:
Sub DeleteExcessRecords()
'Deletes records that are not designated "9MK"
Dim wksData As Worksheet
Dim lngCounter As Long
Dim lngFinalRow As Long

Set wksData = ThisWorkbook.Sheets(1)
wksData.Activate
lngFinalRow = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 14).End(xlUp).Row
For lngCounter = lngFinalRow - 1 To 5 Step -3
If wksData.Cells(lngCounter, 14) <> "9MK" Then
wksData.Rows(lngCounter + 1).Delete
wksData.Rows(lngCounter).Delete
wksData.Rows(lngCounter - 1).Delete
End If
Next
End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,626
Messages
5,838,438
Members
430,548
Latest member
hh_dh2001

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
Top