Copy one excel file into another one row at a time

[theta]

Hi all...

I have a closed workbook with the column "CUSTOMER" and "DATE".

I would like to import this worksheet into the current workbook but based on rules e.g.

The value in the current cell for CUSTOMER = "ABC1" and the date is =>"01/01/2010"

How would I do this? I thought the best method would be with ADO? Or have excel define the usedrange of the workbook containing the data then do an analysis for each ROW copying when the criteria is true, then looping until all ROWS have been checked?

Open Workbook
Define last row
Row(1) check if CUSTOMER = "x" and DATE => "y"
TRUE - copy ROW to current workbook (next blank row)
FALSE - step the Row count and continue the loop
Last Row reached, end the macro

I know SQL would make this easy peasy but not sure it can be used, so maybe the logic above would help?

Really stuck on this so any help appreciated...

[Bob Phillips]

Do it in Excel

- open workbook
- insert a helper column and inject a formula to check the two criteria
- filter the helper column for TRUE
- copy all visible rows
- paste to wherever
- close workbook

[theta]

Hmmm I really hate helper columns

I would rather open the file, test the current ROW (rows 1 - last row) cells meet a criteria - copy if true, if false ignore - then repeat the loop and move on to next row.

Any way to use this approach (as it would teach me alot and be truly flexible for all of my projects)

[theta]

I have been trying to piece something together but the For, Next statement doesn't work (first time I have tried one)

Basically need to keep a counter (c) so that I can increment it by 1 each time the criteria is met (this will be the Row to be used to paste the data in ThisWorkbook).

But it's not working

[VBA]Sub ImportFile()
Dim wb1, wb2 As Workbook
Dim fn$, fnp, r1 As Range, r2 As Range
Dim c As Integer
'Prompt for the file name
fn = Application.GetOpenFilename
Workbooks.Open Filename:=fn
'Parse file name
fnp = Split(fn, "\")
Set wb1 = ThisWorkbook
Set wb2 = Workbooks(fnp(UBound(fnp)))
'Source file range defined
Set r1 = wb2.Worksheets(1).UsedRange
'Destintion range defined
Set r2 = wb1.Worksheets("IMPORT").Range("A1:A1").Resize(r1.Rows.Count, r1.Columns.Count)
c = 1
For Row = 1 To r1.Rows.Count
If r2.Cells(Row, 1).Value = "A" Then c = c + 1
MsgBox c
r2.Rows(c).Value = r1.Rows(Row).Value
Next Row
'Move values
'r2.Value = r1.Value
wb2.Close
End Sub[/VBA]

[Bob Phillips]

Hmmm I really hate helper columns

Why? Why let prejudice rule over pragmatism?

[mdmackillop]

A couple of points
Your code sets WB1 and Wb2 to the same workbook
I don't follow the logic of what you are trying to copy. I suspect the If statement should include some of the subsequent lines.
[VBA]
Sub ImportFile()
Dim wb1, wb2 As Workbook
Dim fn$, fnp, r1 As Range, r2 As Range
Dim c As Integer

Set wb1 = ThisWorkbook

'Prompt for the file name
fn = Application.GetOpenFilename
Set wb2 = Workbooks.Open(fn)

'Source file range defined
Set r1 = wb2.Worksheets(1).UsedRange
'Destintion range defined
Set r2 = wb1.Worksheets("IMPORT").Range("A1:A1").Resize(r1.Rows.Count, r1.Columns.Count)
'For debug
wb1.Activate

c = 1
For Row = 1 To r1.Rows.Count
If r2.Cells(Row, 1).Value = "A" Then c = c + 1
MsgBox c
r2.Rows(c).Value = r1.Rows(Row).Value
Next Row
'Move values
'r2.Value = r1.Value
wb2.Close
End Sub
[/VBA]

[theta]

Sorry there was an r1 / r2 typo

I now have the code working, but I know my IF statement is very 'dirty' and be more elegant / syntatically correct...

This now copies only those rows where column 1 value = "A" and column 4 value is > 5

This ensures no helper columns, no filters and no data makes it into the current workbook that shouldnt be there (macro crash, dont want proprietary data to remain before a filter etc)

Any help on making it more efficient appreciated

[vba]

Sub ImportFile()
Dim wb1, wb2 As Workbook
Dim fn$, fnp, r1 As Range, r2 As Range
Dim c As Integer
'Prompt for the file name
fn = Application.GetOpenFilename
Workbooks.Open Filename:=fn
'Parse file name
fnp = Split(fn, "\")
Set wb1 = ThisWorkbook
Set wb2 = Workbooks(fnp(UBound(fnp)))
'Source file range defined
Set r1 = wb2.Worksheets(1).UsedRange
'Destintion range defined
Set r2 = wb1.Worksheets("IMPORT").Range("A1:A1").Resize(r1.Rows.Count, r1.Columns.Count)
c = 1
For Row = 1 To r1.Rows.Count
If r1.Cells(Row, 1).Value = "A" And r1.Cells(Row, 4) > 5 Then
r2.Rows(c).Value = r1.Rows(Row).Value
c = c + 1
End If
Next Row
'Move values
'r2.Value = r1.Value
wb2.Close
End Sub

[/vba]

[Bob Phillips]

You would rather have a loop than a nice efficient filter. You can always remove the helpers, filters etc. in the code before the finish.

Anyway, here it is filtering

[vba]

Sub ImportFile()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim r1 As Range
Dim r2 As Range
Dim rows1 As Long
Dim rows2 As Long
Dim fn As Variant

Set wb1 = ThisWorkbook
fn = Application.GetOpenFilename
If fn <> "False" Then

Set wb2 = Workbooks.Open(Filename:=fn)

Set ws1 = wb1.Worksheets("IMPORT")
Set ws2 = wb2.Worksheets(1)

Set r1 = ws1.UsedRange
Set r2 = ws2.UsedRange

rows1 = ws1.UsedRange.Rows.Count

With ws2

rows2 = r2.Rows.Count
Set r2 = r2.Resize(, r2.Columns.Count + 1)

.Columns(5).Insert
.Range("E1").Value = "tmp"
.Range("E2").Resize(rows2 - 1).Formula = "=AND(A2=""A"",D2>5)"
r2.AutoFilter Field:=5, Criteria1:="TRUE"
On Error Resume Next
Set r2 = r2.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not r2 Is Nothing Then

r2.EntireRow.Copy r1.Cells(r1.Rows.Count + 1, 1)
r1.Rows(rows1 + 1).EntireRow.Delete
r1.Cells(rows1 + 1, 5).Resize(ws1.UsedRange.Rows.Count - rows1).Delete shift:=xlToLeft
End If
End With

wb2.Close SaveChanges:=False
End If
End Sub[/vba]

[theta]

Perfect I will give it a try...

Looks very good...

This is what I managed in the meantime (still learning)

Your help is very much appreciated

Kind regards

[vba]
Sub ImportFile()
Dim wb1, wb2 As Workbook
Dim fn As Variant
Dim fnp, r1 As Range, r2 As Range
Dim c As Integer
Call BeforeMacros
'Initialise the counter
c = 1
'Prompt for the file name
fn = Application.GetOpenFilename(FileFilter:="XLS* Files (*.xls*), *.xls*", Title:="Please select an Excel file")
If fn = False Then GoTo TheEnd 'Esc pressed
Workbooks.Open Filename:=fn
'Parse file name
fnp = Split(fn, "\")
Set wb1 = ThisWorkbook
Set wb2 = Workbooks(fnp(UBound(fnp)))
'Clear the IMPORT sheet
wb1.Worksheets("IMPORT").UsedRange.Clear
'Source file range defined
Set r1 = wb2.Worksheets(1).UsedRange
'Destintion range defined
Set r2 = wb1.Worksheets("IMPORT").Range("A1:A1").Resize(r1.Rows.Count, r1.Columns.Count)
For Row = 1 To r1.Rows.Count
If r1.Cells(Row, 1).Value = "A" And r1.Cells(Row, 4) > 5 And WordInString(r1.Cells(Row, 6), "_GSM") Then
r2.Rows(c).Value = r1.Rows(Row).Value
c = c + 1
End If
Next Row
'Move values
'r2.Value = r1.Value
'Prompt to save changes as calculation mode changed
wb2.Close
TheEnd:
Call AfterMacros
End Sub
[/vba]

[Bob Phillips]

Are you still seeking help on your latest effort, or just posting it FYI?

[theta]

.

[theta]

Posting as an FYI so if 'googlers' end up here in future they will get a final result that I found workable

Thanks for all the help...

[mdmackillop]

Personally I would go with the Filter solution. For large data it will be much quicker and is also more adaptable.

[theta]

I am going to use both - as it is all good learning