Search Word "End" and copy above row to new tab by VB

P

PPOOQQ

New Member
Joined
Jul 27, 2014
Messages
6
BATCHIntDateAccountNumLineDescriptionProduct TypeDebitAmtCreditAmt FacilityID
IPF-260726/07/2014-11002Clem20140726Fee1044.8875
IPF-260726/07/2014-11002Clem20140726Fee1088.6675
IPF-260726/07/2014-11036Clem20140726Fee144.88075
IPF-260726/07/2014-11036Clem20140726Fee188.66075
IPF-260726/07/2014ENDClem20140726000EN
IPF-2607
26/07/2014Clem20140726000
can anyone help me?I want to copy all rows to new tab above the row which has "END"

<tbody>
</tbody><colgroup><col><col><col><col><col><col><col><col><col></colgroup>
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
PPOOQQ,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


Sample raw data in worksheet Sheet1:


Excel 2007
ABCDEFGH
1BATCHIntDateAccountNumLineDescriptionProduct TypeDebitAmtCreditAmtFacilityID
2IPF-260726/07/2014-11002Clem20140726Fee1044.8875
3IPF-260726/07/2014-11002Clem20140726Fee1088.6675
4IPF-260726/07/2014-11036Clem20140726Fee144.88075
5IPF-260726/07/2014-11036Clem20140726Fee188.66075
6IPF-260726/07/2014ENDClem20140726000EN
7IPF-260726/07/2014Clem20140726000
8
Sheet1


After the macro in a new worksheet Results:


Excel 2007
ABCDEFGH
1BATCHIntDateAccountNumLineDescriptionProduct TypeDebitAmtCreditAmtFacilityID
2IPF-260726/07/2014-11002Clem20140726Fee1044.8875
3IPF-260726/07/2014-11002Clem20140726Fee1088.6675
4IPF-260726/07/2014-11036Clem20140726Fee144.88075
5IPF-260726/07/2014-11036Clem20140726Fee188.66075
6
Results


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code: 
Sub CopyAboveEND()
' hiker95, 07/28/2014, ME794581
Dim w1 As Worksheet, wr As Worksheet
Dim crng As Range
Set w1 = Sheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
wr.UsedRange.ClearContents
Set crng = w1.Columns(3).Find("END", LookAt:=xlWhole)
If crng Is Nothing Then
  MsgBox "The word 'END' was not found - macro terminated!"
  Exit Sub
ElseIf Not crng Is Nothing Then
  w1.Range("A1:H" & crng.Row - 1).Copy Destination:=wr.Range("A1:H" & crng.Row - 1)
  Application.CutCopyMode = False
End If
With wr
  .Columns.AutoFit
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CopyAboveEND macro.
 
Last edited:
Upvote 0
hiker95 said:
PPOOQQ,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


Sample raw data in worksheet Sheet1:

Excel 2007
ABCDEFGH
1BATCHIntDateAccountNumLineDescriptionProduct TypeDebitAmtCreditAmtFacilityID
2IPF-260726/07/2014-11002Clem20140726Fee1044.8875
3IPF-260726/07/2014-11002Clem20140726Fee1088.6675
4IPF-260726/07/2014-11036Clem20140726Fee144.88075
5IPF-260726/07/2014-11036Clem20140726Fee188.66075
6IPF-260726/07/2014ENDClem20140726000EN
7IPF-260726/07/2014Clem20140726000
8

<colgroup><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1​



After the macro in a new worksheet Results:

Excel 2007
ABCDEFGH
1BATCHIntDateAccountNumLineDescriptionProduct TypeDebitAmtCreditAmtFacilityID
2IPF-260726/07/2014-11002Clem20140726Fee1044.8875
3IPF-260726/07/2014-11002Clem20140726Fee1088.6675
4IPF-260726/07/2014-11036Clem20140726Fee144.88075
5IPF-260726/07/2014-11036Clem20140726Fee188.66075
6

<colgroup><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Results​



Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code: 
Sub CopyAboveEND()
' hiker95, 07/28/2014, ME794581
Dim w1 As Worksheet, wr As Worksheet
Dim crng As Range
Set w1 = Sheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
wr.UsedRange.ClearContents
Set crng = w1.Columns(3).Find("END", LookAt:=xlWhole)
If crng Is Nothing Then
  MsgBox "The word 'END' was not found - macro terminated!"
  Exit Sub
ElseIf Not crng Is Nothing Then
  w1.Range("A1:H" & crng.Row - 1).Copy Destination:=wr.Range("A1:H" & crng.Row - 1)
  Application.CutCopyMode = False
End If
With wr
  .Columns.AutoFit
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CopyAboveEND macro.
Click to expand...

that is quick!! thanks for your kindly reply, i am using 2010 on PC

I still have problem which is "END" in my sheet is done by if() formula not really word END. so after I run this I get return "The word 'END' was not found - macro terminated"

can you please change it as well?
 
Upvote 0
PPOOQQ,

QUOTES
1. Quote ONLY if it is needed to add clarity or context for your reply. If so, then
2. Quote ONLY the specific part of the post that is relevant - - not the entire post.

This will keep thread clutter to a minimum and make the discussion easier to follow.


So that I can get it right this next time, I will have to see your actual workbook/worksheet.

You can upload your workbook to 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 provide the above, 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
PPOOQQ,

Thanks for the workbook.

Can we have another workbook with worksheet Data (manually completed by you) for the results you are looking for?
 
Upvote 0
PPOOQQ,

Sorry for the delay. Filtered worksheets makes a difference.

Sample worksheets:


Excel 2007
ABCDEFGHIJKLM
1BATCHIntDateAccountNumLineDescriptionProduct TypeDebitAmtCreditAmtFacilityIDGST
2Video fee-28077/28/201475-1000-11002UC437IPFClem20140728Video Fee Jrnl0.0074.96750
3Video fee-28077/28/201475-1000-11002UC437IPFClem20140728Video Fee Jrnl0.00175.10750
4Video fee-28077/28/201475-1000-11005UC437IPFClem20140728Video Fee Jrnl23.950.00750
5Video fee-28077/28/201475-1000-11036UC437IPFClem20140728Video Fee Jrnl74.960.00750
6Video fee-28077/28/201475-1000-11036UC437IPFClem20140728Video Fee Jrnl175.100.00750
7Video fee-28077/28/201475-1000-11103UC437IPFClem20140728Video Fee Jrnl16.830.00750
8Video fee-28077/28/201475-1000-11110UC437IPFClem20140728Video Fee Jrnl0.510.00750
9Video fee-28077/28/201475-1000-11113UC437IPFClem20140728Video Fee Jrnl0.0023.95750
10Video fee-28077/28/201475-1000-11113UC437IPFClem20140728Video Fee Jrnl2.040.00750
11Video fee-28077/28/201475-1000-21005UC437IPFClem20140728Video Fee Jrnl175.100.00750
12Video fee-28077/28/201475-1000-21007UC437IPFClem20140728Video Fee Jrnl74.960.00750
13Video fee-28077/28/201475-1000-21008UC437IPFClem20140728Video Fee Jrnl8.160.00750
14Video fee-28077/28/201475-1000-40250UC437IPFClem20140728Video Fee Jrnl0.00175.1075-S-GST-IN7575-S-GST-IN
15Video fee-28077/28/201475-1000-40450UC437IPFClem20140728Video Fee Jrnl0.0074.9675-S-GST-IN7575-S-GST-IN
16Video fee-28077/28/201475-1000-40550UC437IPFClem20140728Video Fee Jrnl0.002.0475-S-GST-IN7575-S-GST-IN
17Video fee-28077/28/201475-1000-40650UC437IPFClem20140728Video Fee Jrnl0.008.1675-S-GST-IN7575-S-GST-IN
18Video fee-28077/28/201475-1000-40750UC437IPFClem20140728Video Fee Jrnl0.0016.8375-S-GST-IN7575-S-GST-IN
19Video fee-28077/28/201475-1000-41050UC437IPFClem20140728Video Fee Jrnl0.000.5175-S-GST-IN7575-S-GST-IN
20Video fee-28077/28/2014ENDUC437IPFClem2014072800.000.00EN0
21Video fee-28077/28/2014UC437IPFClem2014072800.000.000
22Video fee-28077/28/2014UC437IPFClem2014072800.000.000
23Video fee-28077/28/2014UC437IPFClem2014072800.000.000
24Video fee-28077/28/2014UC437IPFClem2014072800.000.000
25Video fee-28077/28/2014UC437IPFClem2014072800.000.00Page 1 of 1Page 1 of 1
26Video fee-28077/28/2014UC437IPFClem2014072800.000.000
27
Video fee-posting



Excel 2007
ABCDEFGHIJKLM
1BATCHIntDateAccountNumLineDescriptionProduct TypeDebitAmtCreditAmtFacilityIDGST
2revenue-28077/28/201475-1000-21105UC485CustCredClem20140728Revenue4.780.00750
3revenue-28077/28/201475-1000-11040UC485CustCredClem20140728Revenue0.004.78750
4revenue-28077/28/201475-1000-60905UC485CustCredClem20140728Revenue4.780.0075-S-GST-IN7575-S-GST-IN
5revenue-28077/28/201475-1000-21005UC485CustCredClem20140728Revenue0.004.78750
6revenue-28077/28/2014ENDUC485CustCredClem2014072800.000.00EN0
7revenue-28077/28/2014UC485CustCredClem2014072800.000.000
8revenue-28077/28/2014UC485CustCredClem2014072800.000.000
9revenue-28077/28/2014UC485CustCredClem2014072800.000.000
10
revenue-posting



Excel 2007
ABCDEFGHI
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Data


After the macro in worksheet Data:


Excel 2007
ABCDEFGHI
1
2Video fee-28077/28/201475-1000-11002UC437IPFClem20140728Video Fee Jrnl-74.9675
3Video fee-28077/28/201475-1000-11002UC437IPFClem20140728Video Fee Jrnl-175.1075
4Video fee-28077/28/201475-1000-11005UC437IPFClem20140728Video Fee Jrnl23.95-75
5Video fee-28077/28/201475-1000-11036UC437IPFClem20140728Video Fee Jrnl74.96-75
6Video fee-28077/28/201475-1000-11036UC437IPFClem20140728Video Fee Jrnl175.10-75
7Video fee-28077/28/201475-1000-11103UC437IPFClem20140728Video Fee Jrnl16.83-75
8Video fee-28077/28/201475-1000-11110UC437IPFClem20140728Video Fee Jrnl0.51-75
9Video fee-28077/28/201475-1000-11113UC437IPFClem20140728Video Fee Jrnl-23.9575
10Video fee-28077/28/201475-1000-11113UC437IPFClem20140728Video Fee Jrnl2.04-75
11Video fee-28077/28/201475-1000-21005UC437IPFClem20140728Video Fee Jrnl175.10-75
12Video fee-28077/28/201475-1000-21007UC437IPFClem20140728Video Fee Jrnl74.96-75
13Video fee-28077/28/201475-1000-21008UC437IPFClem20140728Video Fee Jrnl8.16-75
14Video fee-28077/28/201475-1000-40250UC437IPFClem20140728Video Fee Jrnl-175.1075-S-GST-IN75
15Video fee-28077/28/201475-1000-40450UC437IPFClem20140728Video Fee Jrnl-74.9675-S-GST-IN75
16Video fee-28077/28/201475-1000-40550UC437IPFClem20140728Video Fee Jrnl-2.0475-S-GST-IN75
17Video fee-28077/28/201475-1000-40650UC437IPFClem20140728Video Fee Jrnl-8.1675-S-GST-IN75
18Video fee-28077/28/201475-1000-40750UC437IPFClem20140728Video Fee Jrnl-16.8375-S-GST-IN75
19Video fee-28077/28/201475-1000-41050UC437IPFClem20140728Video Fee Jrnl-0.5175-S-GST-IN75
20revenue-28077/28/201475-1000-21105UC485CustCredClem20140728Revenue4.78-75
21revenue-28077/28/201475-1000-11040UC485CustCredClem20140728Revenue-4.7875
22revenue-28077/28/201475-1000-60905UC485CustCredClem20140728Revenue4.78-75-S-GST-IN75
23revenue-28077/28/201475-1000-21005UC485CustCredClem20140728Revenue-4.7875
24
Data


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code: 
Sub CopyAboveEND_V3()
' hiker95, 07/29/2014, ME794581
Dim vfp As Worksheet, rp As Worksheet, wd As Worksheet
Dim nr As Long, r As Long, lr As Long, fr As Long
Application.ScreenUpdating = False
Set vfp = Sheets("Video fee-posting")
Set rp = Sheets("revenue-posting")
Set wd = Sheets("Data")
wd.Columns("A:I").ClearContents
With vfp
  If .FilterMode = True Then
    .ShowAllData
  End If
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = 2 To lr Step 1
    If .Cells(r, 3).Value = "END" Then
      fr = r
      Exit For
    End If
  Next r
  nr = wd.Cells(wd.Rows.Count, "A").End(xlUp).Row + 1
  .Range("A2:I" & fr - 1).Copy
  wd.Range("A" & nr).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
End With
With rp
  If .FilterMode = True Then
    .ShowAllData
  End If
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = 2 To lr Step 1
    If .Cells(r, 3).Value = "END" Then
      fr = r
      Exit For
    End If
  Next r
  nr = wd.Cells(wd.Rows.Count, "A").End(xlUp).Row + 1
  .Range("A2:I" & fr - 1).Copy
  wd.Range("A" & nr).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
End With
With wd
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("B2:B" & lr).NumberFormat = "m/d/yyyy"
  .Range("F2:G" & lr).NumberFormat = "_-* #,##0.00_-;-* #,##0.00_-;_-* ""-""??_-;_-@_-"
  .Columns("A:I").AutoFit
  .Range("A1").Select
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CopyAboveEND_V3 macro.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
vba to run through sorted list and copy rows in each sorted group into a new tab
Replies
3
Views
893
vcoolio
V
G
  • Question
sum a date range
Replies
2
Views
519
Gealer
G
S
  • Question
search for string, then copy multiple cells to new sheet
2
Replies
14
Views
445
solidENM
S
F
  • Question
Roll up rows into another tab for annual leave calendar.
Replies
1
Views
447
Rijnsent
Rijnsent
L
  • Question
VBA - Macro to Output Data into Tab Based on Criteria
Replies
0
Views
560
lpw0806
L

Forum statistics

Threads
1,214,635
Messages
6,120,660
Members
448,975
Latest member
sweeberry

Share this page

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