VBA: Filter and Copy Data into Next Available Row

nickshep85

New Member
Joined
Mar 21, 2012
Messages
37
Hi all,

I have a macro which I am working on that imports a large text file into Excel. This text file then needs to be separated into two sheets "Tyres" and "Mechanical". I have got so far as to import the file, then show which rows need to be transferred to which sheets, but am stuck on how I would do this. Please can someone put me out of my misery?

Code:
Sub Transfer_Data()

'Add New Workbook
Workbooks.Add template:=xlWorksheet

      Dim mypath As String
      mypath = ThisWorkbook.Path

'Add New Sheet and Overwrite Last File
ActiveWorkbook.Sheets.Add
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs (mypath & "/ImportFile.xls")
    Application.DisplayAlerts = True
    
'Name Sheets
Sheets("Sheet1").Name = "Tyres"
Sheets("Sheet2").Name = "Mechanical"

'Add Title and Date into Both Sheets
Dim wksh As Worksheet
On Error Resume Next
For Each wksh In Worksheets
    With wksh
    .Range("A1").FormulaR1C1 = "=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-5)"

    .Range("B1").FormulaR1C1 = "=today()"
    .Range("B1").Select

    .Range("B1").Copy
    .Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Application.Goto Reference:="R1C1"
    .Application.CutCopyMode = False
    
    'Add Headers into both Sheets
    .Range("A2").Value = "CODE"
    .Range("B2").Value = "DESCRIPTION"
    .Range("C2").Value = "XXX"
    .Range("D2").Value = "XXX"
    .Range("E2").Value = "XXX"
    .Range("F2").Value = "XXX"
    .Range("G2").Value = "PRICE"
    .Range("H2").Value = "XXX"
    .Range("I2").Value = "XXX"
  
    End With
    
    Next wksh
    
    'Format Both Sheets
    Sheets.Select
    Range("A1:I2").Select
    With Selection
      .Font.Size = 14
      .Font.Bold = True
      .Font.Color = vbWhite
      .Interior.Color = vbBlue
    End With
    
    Range("A1").Select
    Sheets("Tyres").Activate

    'Set LastRows for both sheets
    Dim LastTyres As Long
    LastTyres = Sheets("Tyres").Cells.Find(What:="*", _
    searchdirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
        
    Sheets("Mechanical").Activate
    
    Dim LastMech As Long
    LastMech = Sheets("Mechanical").Cells.Find(What:="*", _
    searchdirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
    
    'Copy TRUE Values from PriceFile into next available row in Mechanical
    
    
End Sub

The file "PriceFile" is my imported text file which, depending on the size of the file, may be over two or more sheets. Column I in each sheet has a formula which gives a TRUE / FALSE result. For this, rows with TRUE values need to be transferred into the "Mechanical" sheet in "ImportFile". Rows with FALSE values need to be transferred into the "Tyres" sheet.

The data in the below example would be transferred into the Mechanical Sheet, my PriceFile workbook uses "XXX" just as column headers.

XXXXXXXXXXXXXXXXXXXXXXXXXXX
P122XZY08M12-22.5 XZY P/W 08MM999XXR24116.05116.96VSV999TRUE

<tbody>
</tbody>

Any help in this would be much appreciated, a final solution even more so.

Thanks.
 

Some videos you may like

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

nickshep85

New Member
Joined
Mar 21, 2012
Messages
37
EDIT:

Since I posted this thread I have tried to filter out my results by adding in the below code

Code:
    'Copy TRUE Values from PriceFile into next available row in Mechanical
    Workbooks("PriceFile").Activate
    
    For Each ws In Worksheets
    
    With ws
    .AutoFilterMode = False
        With Range("I2", Range("I" & Rows.Count).End(xlUp))
            .AutoFilter 1, "TRUE"
            On Error Resume Next
            .Offset(0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        End With
        
        Workbooks("ImportFile").Activate
        Sheets("Mechanical").Activate
        Range("A" & LastMech + 1).PasteSpecial (xlPasteAll)
        
        
    End With
    Next ws

This does select the correct cells from the first sheet in PriceFile and pastes them into the Mechanical tab in ImportFile, but when this should loop back to the PriceFile workbook to filter the next sheet, it filters the data in my ImportFile.

Can anyone see what I'm doing wrong here?
 

Trevor G

Well-known Member
Joined
Jul 17, 2008
Messages
6,701
Office Version
  1. 2016
Platform
  1. Windows
Use

ws.Activate below the with ws
 

Kyle123

Well-known Member
Joined
Jan 24, 2012
Messages
2,708
Rich (BB code):
With Range("I2", Range("I" & Rows.Count).End(xlUp)
Should be:
Rich (BB code):
With .Range("I2", Range("I" & Rows.Count).End(xlUp)
 

nickshep85

New Member
Joined
Mar 21, 2012
Messages
37
OK, next problem. When I run this, the first sheet in PriceFile starts with FALSE in Col I, the code selects Row 1 and then pastes into the next available row in ImportFile, which is not what I need. It then loops back to Sheet2 and copies the rows with a TRUE value and pastes them as it should.

Any ideas? Shall I upload the PriceFile as an attachment if it will help?
 

nickshep85

New Member
Joined
Mar 21, 2012
Messages
37
Sheet1 is something like below:

XXX
XXXXXXXXXXXXXXXXXXXXXXXX
100015BANDBTARM
1000-15 B/DAG BTA REM TL25XXG18106.58170.06RLT999FALSE
100015BANDCAS10-15 BAND CASING25991981515CAS999FALSE
100015XMINED21000-15 MICH XMINE D2 TL1XXG18829.281180.45ERT999FALSE
100015XTA1000-15 MICH XTA1XXG18390.72530.77NLT001FALSE
100015YOKOCAS100015YOKOCAS228ZZZZZ55CAS999FALSE
10001690903RIFR1000-16 BKT 9090 3 RIB T/FRO4109921C78.65117.97AGR999FALSE
1000169SUPRRIB81000-16SUPR 9090 3RIBT/FR PR81489921C66.1118.95AGR999FALSE
P122XZY04M12-22.5 XZY P/W 04MM999XXR2458.0258.93VSV999TRUE
P122XZY06M12-22.5 XZY P/W 06MM999XXR2487.0487.95VSV999TRUE

<tbody>
</tbody>


And Sheet2 is like the below:

XXX
XXXXXXXXXXXXXXXXXXXXXXXX
P122XZY08M12-22.5 XZY P/W 08MM999XXR24116.05116.96VSV999TRUE
P122XZY10M12-22.5 XZY P/W 10MM999XXR24145.06145.97VSV999TRUE
P122XZY12M12-22.5 XZY P/W 12MM999XXR24174.07174.98VSV999TRUE
P122XZYR02M12-22.5 XZY REM P/W 02MM999XXR2414.5115.42RHT999TRUE
P122XZYR04M12-22.5 XZY REM P/W 04MM999XXR2429.0229.93RHT999TRUE
P122XZYR06M12-22.5 XZY REM P/W 06MM999XXR2443.5344.44RHT999TRUE
P122XZYR08M12-22.5 XZY REM P/W 08MM999XXR2458.0358.94RHT999TRUE
P122XZYR10M12-22.5 XZY REM P/W 10MM999XXR2472.5473.45RHT999TRUE
P122XZYR12M12-22.5 XZY REM P/W 12MM999XXR2487.0587.96RHT999TRUE

<tbody>
</tbody>

So I would need the last two rows from Sheet1 and all of Sheet 2 inserted into Mechanical on ImportFile.xls. The FALSE values from sheet1 would need to go into the Tyres tab in ImportFile.xls.

Apologies for the tables, but I was unsure of the best way to show my data.

Any help is greatly appreciated, I can feel the grey hairs multiplying by the day!
 

Watch MrExcel Video

Forum statistics

Threads
1,122,881
Messages
5,598,636
Members
414,251
Latest member
oExcel

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