Finding text, copying row & pasting into separate sheet

P

PE New User

New Member
Joined
Aug 4, 2014
Messages
21
Hi,

I am pretty sure that this should be a relatively straight forward macro, but I can't seem to work it out. I am trying to find data in a spreadsheet (data always in column H), once found copy the entire row and paste the row into a different tab.

There are multiple rows within the original (Data Sheet) tab that will contain the specific text (Natural Gas) so I want the macro to loop through and copy all rows with Natural Gas in column H to the new tab:

Original Sheet
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Client Name[/TD]
[TD]Site Name[/TD]
[TD].....[/TD]
[TD]....[/TD]
[TD].....[/TD]
[TD].....[/TD]
[TD].....[/TD]
[TD]Product[/TD]
[/TR]
[TR]
[TD]ABC Intl Ltd[/TD]
[TD]1 ABC Street[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Electricity HH[/TD]
[/TR]
[TR]
[TD]ABC Intl Ltd[/TD]
[TD]2 ABC Street[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Natural Gas[/TD]
[/TR]
[TR]
[TD]ABC Intl Ltd[/TD]
[TD]3 ABC Street[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Electricity NHH[/TD]
[/TR]
[TR]
[TD]ABC Intl Ltd[/TD]
[TD]3 ABC Street[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Natural Gas[/TD]
[/TR]
[TR]
[TD]ABC Intl Ltd[/TD]
[TD]4 ABC Street[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Natural Gas[/TD]
[/TR]
[TR]
[TD]ABC Intl Ltd[/TD]
[TD]7 ABC Street[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Electricity HH[/TD]
[/TR]
</tbody>[/TABLE]

New Sheet
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Client Name[/TD]
[TD]Site Name[/TD]
[TD].....[/TD]
[TD]....[/TD]
[TD].....[/TD]
[TD].....[/TD]
[TD].....[/TD]
[TD]Product[/TD]
[/TR]
[TR]
[TD]ABC Intl Ltd[/TD]
[TD]2 ABC Street[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Natural Gas[/TD]
[/TR]
[TR]
[TD]ABC Intl Ltd[/TD]
[TD]3 ABC Street[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Natural Gas[/TD]
[/TR]
[TR]
[TD]ABC Intl Ltd[/TD]
[TD]4 ABC Street[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Natural Gas[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I have been playing with script and have come up with the following so far, but it only really works to the point of EntireRow.Copy - I can't quite work out how to get the select tab "Gas" and paste the row in the first available row before the loop:

Code: 
Sub GasExtract()


Dim rngH As Range
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    Worksheets("DATA SHEET").Activate
    
    Range("H2").Select
    'Range(Selection, Selection.End(xlDown)).Select
 
 x = 2
 Do Until Range("H" & x) = ""
    If Range("H" & x).Value = "Natural Gas" Then Range("H" & x).EntireRow.Copy
        Sheets("Gas").Select
    ' Go to last cell and extend down
        Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    ' Copy formula from cell above
        Rows(Selection.Row - 1).Copy
        Rows(Selection.Row).PasteSpecial


x = x + 1
Loop
        
    With Application
       .ScreenUpdating = True
       .EnableEvents = True
    End With
     
End Sub

Would appreciate any assistance that can be provided.
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
I think this:

Code: 
Sub CopyRows()
Application.ScreenUpdating = False
Dim lrsource As Long
Dim lrdest As Long
Dim i As Long
lrsource = Sheets("DATA SHEET").Cells(Rows.Count, "H").End(xlUp).Row
lrdest = Sheets("Gas").Cells(Rows.Count, "H").End(xlUp).Row


For i = 2 To lrsource
    If Range("H" & i).Value = "Natural Gas" Then
        Rows(i).copy Destination:=Sheets("Gas").Range("A" & lrdest)
        lrdest = lrdest + 1
    End If
Next i
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Code: 
Sub GasExtract()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim dws As Worksheet
    Dim gas As Worksheet
    
    Dim findVal As String
    ' The value to copy on in **all caps** (you'll see why later)
    findVal = "NATURAL GAS"
    
    ' Name your sheets
    Set dws = ThisWorkbook.Sheets("DATA SHEET")
    Set gas = ThisWorkbook.Sheets("Gas")
    
    Dim maxRow As Long
    Dim nextRow As Long
    
    ' find max row for loop and dim next row for copying
    maxRow = dws.Cells(Rows.Count, "H").End(xlUp).Row
    nextRow = 2
    
    
    ' Add the header
    gas.Rows(1).EntireRow.Value = dws.Rows(1).EntireRow.Value
    
    
    'Loop through the rows
    For x = 2 To maxRow
        'Eliminate enter errors by using uppercase
        If UCase(dws.Cells(x, 8)) = findVal Then
            gas.Cells(nextRow, 1).EntireRow.Value = dws.Cells(x, 1).EntireRow.Value
            nextRow = nextRow + 1
        End If
    Next x
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    




End Sub

Commented out for your learning ability.
 
Upvote 0
PE New User,

Sample worksheets:


Excel 2007
ABCDEFGH
1Client NameSite Name........................Product
2ABC Intl Ltd1 ABC StreetElectricity HH
3ABC Intl Ltd2 ABC StreetNatural Gas
4ABC Intl Ltd3 ABC StreetElectricity NHH
5ABC Intl Ltd3 ABC StreetNatural Gas
6ABC Intl Ltd4 ABC StreetNatural Gas
7ABC Intl Ltd7 ABC StreetElectricity HH
8
DATA SHEET



Excel 2007
ABCDEFGH
1Client NameSite Name........................Product
2
3
4
5
Gas


After the macro (using two array in memory) in worksheet Gas:


Excel 2007
ABCDEFGH
1Client NameSite Name........................Product
2ABC Intl Ltd2 ABC StreetNatural Gas
3ABC Intl Ltd3 ABC StreetNatural Gas
4ABC Intl Ltd4 ABC StreetNatural Gas
5
Gas


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 GetNaturalGas()
' hiker95, 09/11/2014, ME804813
Dim wd As Worksheet, wg As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long, c As Long
Dim lr As Long, n As Long
Set wd = Sheets("DATA SHEET")
With wd
  n = Application.CountIf(.Columns(8), "Natural Gas")
  If n = 0 Then
    MsgBox "Sheet " & wd & " column H 'Product' does not contain 'Natural Gas' - macro terminated!"
    Exit Sub
  End If
  Application.ScreenUpdating = False
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  a = .Range("A1:H" & lr).Value
  ReDim o(1 To n + 1, 1 To 8)
End With
j = j + 1
For c = 1 To 8
  o(j, c) = a(1, c)
Next c
For i = 2 To lr
  If a(i, 8) = "Natural Gas" Then
    j = j + 1
    For c = 1 To 8
      o(j, c) = a(i, c)
    Next c
  End If
Next i
If Not Evaluate("ISREF(Gas!A1)") Then Worksheets.Add(After:=wd).Name = "Gas"
Set wg = Sheets("Gas")
With wg
  .UsedRange.ClearContents
  .Cells(1, 1).Resize(n + 1, 8).Value = o
  .UsedRange.Columns.AutoFit
  .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 GetNaturalGas macro.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
How would i use the FIND method with the AND operator to find any two words in a sheet cell, i.e., "understanding" AND "heart"
2
Replies
11
Views
485
Trebor76
T
R
  • Solved
I need to find a row based on multiple criteria, with a catch.
2
Replies
13
Views
1K
rcrumbliss
R
C
  • Question Question
Copy, paste data from one sheet to another based on specific text
Replies
1
Views
749
OaklandJim
O
M
  • Solved
cut/copy and paste row based on cell value not being equal to specific text
Replies
6
Views
274
mlan1604
M
Y
  • Question Question
Copy data to another sheet last row
Replies
1
Views
460
Joe4
Joe4

Forum statistics

Threads
1,222,312
Messages
6,165,272
Members
451,949
Latest member
bovacik

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