combining two codes to extract data instead of repeat the code twice

[MKLAQ]

Hi experts
I need combining two code instead of repeat the code again for different ranges
so the code import data from Prompt user to browse & Select file from folder . I have two ranges for two files when select from folder
first

 Sub ge_tdata()
 Dim ar As Variant, lRw As Long


 lRw = ThisWorkbook.Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row

 With Application.FileDialog(msoFileDialogFilePicker)
   If .Show Then
      With GetObject(.SelectedItems(1))
         ar = .Sheets("rp").Range("g2:i100").Value
        
         ThisWorkbook.Sheets("sheet1").Cells(lRw + 1, 2).Resize(UBound(ar), UBound(ar, 2)) = ar
        .Close 0
        End If
      End With
   End If
 End With
End Sub

second

 Sub ge_tdata()
 Dim ar As Variant, lRw As Long


 lRw = ThisWorkbook.Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row

 With Application.FileDialog(msoFileDialogFilePicker)
   If .Show Then
      With GetObject(.SelectedItems(1))
         ar = .Sheets("rp").Range("A2:E100").Value
     
         ThisWorkbook.Sheets("sheet1").Cells(lRw + 1, 2).Resize(UBound(ar), UBound(ar, 2)) = ar
        .Close 0
        End If
      End With
   End If
 End With
End Sub

as you see there is different in ranges.
I have some notices if it's possible just select the folder and pull data from files without select files and when pull data should skip blank cells in ranges or make search for tha lastrow instead of specify the range every time .
I hope finding easy way to do that .

 

[Anthony47]

Assuming that in both the cases the user select the same file, then:

Sub ge_tBoth()
 Dim ar As Variant, lRw As Long

 lRw = ThisWorkbook.Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row

 With Application.FileDialog(msoFileDialogFilePicker)
   If .Show Then
      With GetObject(.SelectedItems(1))
         ar = .Sheets("rp").Range("g2:i100").Value
         ThisWorkbook.Sheets("sheet1").Cells(lRw + 1, 2).Resize(UBound(ar), UBound(ar, 2)) = ar
'second range:
         ar = .Sheets("rp").Range("A2:E100").Value
         lRw = ThisWorkbook.Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row
         ThisWorkbook.Sheets("sheet1").Cells(lRw + 1, 2).Resize(UBound(ar), UBound(ar, 2)) = ar
        .Close 0
        End If
      End With
   End If
 End With
End Sub

 

[MKLAQ]

thanks anthony for your trying !
based on OP I have multiple files , if there is possible way to pull data by select folder contains files without open any file , just indicate to sheet name and range ,then the code will pull data from files are existed in folder . instead of select each file seperately and repeat the code because there are different ranges in location .

 

[Anthony47]

This is much different than the first message, but much clearer. You should however clarify which is/are the ranges to pull ("g2:i100"? "A2:E100"? Both?) and if there is, in the data to be fetched, a column that can be used to determine which is the last one with data (supect it's A, but this is only a guess)

 

[MKLAQ]

This is much different than the first message

I no know what you say that despite I said

I have two ranges for two files when select from folder

and you said

Assuming that in both the cases the user select the same file

I didn't say the same file contains two different renges

You should however clarify which is/are the ranges to pull ("g2:i100"? "A2:E100"? Both?)

should pull data for both ranges with two files

and if there is, in the data to be fetched, a column that can be used to determine which is the last one with data (supect it's A, but this is only a guess)

actually I don't undrestand it, can you clarify,please?

 

[Anthony47]

I'm sorry but I have to admit I'm more confused than before.
My suggestion is that you try again to explain the current situation giving the key information: where are the files to import (I understood that you would like to be able to choose the folder that contains them, and then import from each file is in the path); the structure of the sheet you need to import (an image could suffice); which range you need to import from the sheet.
Keep in mind that you know very well your problem, while we can only understand it from your words...

 

[MKLAQ]

FILE IMPORT-MM.XLSM

IMPORT-MM.xlsm
	A	B	C	D	E
1	ITEM	ID	BRAND	BUYING	SELLING
2	1	CCR1-CMB1	C-BM-100	233	100
3	2	CCR1-CMB2	C-BM-101	123
4	3	CCR1-CMB3	C-BM-102	124
5	4	CCR1-CMB4	C-BM-103	123	2
6	5	CCR1-CMB5	C-BM-104	44	3
7	6	CCR1-CMB6	C-BM-105	55	4
8	7	CCR1-CMB7	C-BM-106	66
9	8	CCR1-CMB8	C-BM-107	77	700
10	9	CCR1-CMB9	C-BM-108	88	12
RP

file REPORT.xlsx

REPORT.xlsx
	G	H	I	J	K
1	ITEM	ID	BRAND	BUYING	SELLING
2	1	CCR1-CMB1	C-BM-100	120	9
3	2	CCR1-CMB2	C-BM-101	1233	12
4	3	CCR1-CMB13	C-BM-112	345	4
5	4	CCR1-CMB14	C-BM-113	456
6	5	CCR1-CMB15	C-BM-114	123	34
7	6	CCR1-CMB16	C-BM-115	5678	76
8	7	CCR1-CMB7	C-BM-106	66
9	8	CCR1-CMB8	C-BM-107	77	700
RP

the output should be

output.xlsm
	A	B	C	D	E
1	ITEM	ID	BRAND	BUYING	SELLING
2	1	CCR1-CMB1	C-BM-100	233	100
3	2	CCR1-CMB2	C-BM-101	123
4	3	CCR1-CMB3	C-BM-102	124
5	4	CCR1-CMB4	C-BM-103	123	2
6	5	CCR1-CMB5	C-BM-104	44	3
7	6	CCR1-CMB6	C-BM-105	55	4
8	7	CCR1-CMB7	C-BM-106	66
9	8	CCR1-CMB8	C-BM-107	77	700
10	9	CCR1-CMB9	C-BM-108	88	12
11	10	CCR1-CMB1	C-BM-100	120	9
12	11	CCR1-CMB2	C-BM-101	1233	12
13	12	CCR1-CMB13	C-BM-112	345	4
14	13	CCR1-CMB14	C-BM-113	456
15	14	CCR1-CMB15	C-BM-114	123	34
16	15	CCR1-CMB16	C-BM-115	5678	76
17	16	CCR1-CMB7	C-BM-106	66
18	17	CCR1-CMB8	C-BM-107	77	700
sheet1

and every time the run macro should clear data in file output from A2:E before brings data

 

[JEC]

Hi, try to run this macro

Sub jec()
 Dim ar, x00, x01, x02
 ar = Array("ITEM", "ID", "BRAND", "BUYING", "SELLING")
 x02 = "SELECT " & Join(ar, ", ") & " FROM `rp$`"
 With Application.FileDialog(4)
   If .Show Then
   
     With Sheet1.Cells(1)
        .CurrentRegion.ClearContents
        .Resize(, 5) = ar
     End With
     
     x00 = Dir(.SelectedItems(1) & "\")
     
     Do Until x00 = ""
       x01 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & .SelectedItems(1) & "\" & x00 & ";Extended Properties=""Excel 12.0"""
       With CreateObject("ADODB.recordset")
         .Open x02, x01
          Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1).CopyFromRecordset .DataSource
         .Close
       End With
       x00 = Dir
     Loop
   End If
 End With
End Sub

 

[MKLAQ]

@JEC
wow ! this is awesome !!
just last thing if you don't mind . actually I have another macro to do that, but I truly appreciate that if you can add this procedure for your code , can I merge values for columns BUYING & SELLING based on column ID when pull data from folder please?

 

[JEC]

It's not totally clear to me. But here a suggestion, adding a dictionary

Sub jec()
 Dim Dic, ar, a, x, x00, x01, x02, j As Long
 ar = Array("ITEM", "ID", "BRAND", "BUYING", "SELLING")
 x02 = "SELECT " & Join(ar, ", ") & " FROM `rp$`"
 
 With Application.FileDialog(4)
   If .Show Then
 
     With Sheet1.Cells(1)
        .CurrentRegion.ClearContents
        .Resize(, 5) = ar
     End With
   
     x00 = Dir(.SelectedItems(1) & "\")
     Set dic = CreateObject("scripting.dictionary")
   
     Do Until x00 = ""
       x01 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & .SelectedItems(1) & "\" & x00 & ";Extended Properties=""Excel 12.0"""
       With CreateObject("ADODB.recordset")
           .Open x02, x01
            a = .getrows
            For j = 0 To UBound(a, 2)
               If Not dic.exists(a(0, j) & "_") Then
                  dic(a(0, j) & "_") = Array(a(0, j), a(1, j), a(2, j), a(3, j), Val(a(4, j) & "_"))
               Else
                  x = dic(a(0, j) & "_")
                  x(3) = x(3) + a(3, j)
                  x(4) = x(4) + Val(a(4, j) & "_")
                  dic(a(0, j) & "_") = x
               End If
            Next
           .Close
       End With
       x00 = Dir
     Loop
     Sheets(1).Range("A2").Resize(dic.Count, 5) = Application.Index(dic.items, 0, 0)
   End If
 End With
End Sub