Macro collating data wrongly

A

aaravgaba

New Member
Joined
Sep 15, 2013
Messages
24
Hi Genius People,

I have the below code running for a sheet where I am collating data from various sheets.

The macro is running fine but the problems comes when it is pasting the values in the master sheet, where the last rows of the data are empty. Like in the below table the macro will paste po number till a3 but thereafter it will pick the PO number from the other sheet and will paste right under a3 thereby creating conflict in the table. I want that it should paste the data in each row relating to that very sheet. I know it is confusing but I am not able to attach the file to make it more specific. Thanks

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Po number[/TD]
[TD]part number[/TD]
[TD]status[/TD]
[TD]qty[/TD]
[/TR]
[TR]
[TD]a1[/TD]
[TD]1234[/TD]
[TD]packed[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]a2[/TD]
[TD][/TD]
[TD]picked[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]a3[/TD]
[TD]1121[/TD]
[TD][/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1212[/TD]
[TD]despatched[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]43445[/TD]
[TD]received[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3333[/TD]
[TD]packed[/TD]
[TD]5[/TD]
[/TR]
</tbody>[/TABLE]


Code: 
Sub Get_Info_By_Headers()
    Dim sPath As String
    Dim sFil As String
    Dim owb As Workbook
    Dim twb As Workbook
    Dim ch
    Dim j As Long, a As Long
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    ch = Array("po number", "part number", "status", "quantity")
    Set twb = ThisWorkbook
    sPath = "C:\Users\dipak\Desktop\CRASH REPORT\"
    sFil = Dir(sPath & "*.xl*")
    Do While sFil <> "" And sFil <> twb.Name
        Set owb = Workbooks.Open(sPath & sFil)
            With owb.Sheets("data")
                For j = LBound(ch) To UBound(ch)
                    a = .Rows(1).Find(ch(j), , , 1).Column
                    .Range(.Cells(2, a), .Cells(.Cells(.Rows.Count, a).End(xlUp).Row, a)).Copy twb.Sheets("report").Cells(Rows.Count, j + 1).End(xlUp).Offset(1)
                Next j
            End With
        owb.Close False 'Close no save
        sFil = Dir
    Loop


    With Application
        .Calculation = xlAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
The macro copies the data in each column as it identified in the Find statement. As written, it would not paste anything in column A below the 'a3' entry because there is nothing in the source column below that entry. Can you describe what you want as a result, or post an illustration of it?
 
Upvote 0
Sorry i was not specific. I have many spreadsheets from where the data is taken. So what macro will do is to copy po number from another sheet and will paste po number right after a3 whereas it should leave the two empty cells to maintain the data integrity. So what happens is the final sheet depicts wrong po number against some other part number status and quantity. I want that it should paste the other sheet only after end of active cell of the sheet and not of the column only.
 
Upvote 0
I am reproducing the sheets in below table and the results i am getting and also the result i am anticipating.


first sheet

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]po number[/TD]
[TD]part number[/TD]
[TD]status[/TD]
[TD]quantity[/TD]
[/TR]
[TR]
[TD]a1[/TD]
[TD]1234[/TD]
[TD]packed[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]a2[/TD]
[TD][/TD]
[TD]picked[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]a3[/TD]
[TD]1121[/TD]
[TD][/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1212[/TD]
[TD]despatched[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]43445[/TD]
[TD]received[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3333[/TD]
[TD]packed[/TD]
[TD]5[/TD]
[/TR]
</tbody>[/TABLE]

SECOND SHEET
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]po number[/TD]
[TD]part number[/TD]
[TD]status[/TD]
[TD]quantity[/TD]
[/TR]
[TR]
[TD]aaaa[/TD]
[TD]AARAV[/TD]
[TD]PACKED[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]vvv[/TD]
[TD]DEEPAK[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ddd[/TD]
[TD]C[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]eee[/TD]
[TD]D[/TD]
[TD]PACKED[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]PACKED[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]ghhh[/TD]
[TD][/TD]
[TD]PACKED[/TD]
[TD]5[/TD]
[/TR]
</tbody>[/TABLE]


THIRD SHEET
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]po number[/TD]
[TD]part number[/TD]
[TD]status[/TD]
[TD]quantity[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Z[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]X[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]C[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]V[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD]G[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD]N[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
</tbody>[/TABLE]

RESULT I SHOULD GET AND I ANTICIPATE

[TABLE="class: grid, width: 256"]
<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]Po number[/TD]
[TD="width: 64"]part number[/TD]
[TD="width: 64"]status[/TD]
[TD="width: 64"]quantity[/TD]
[/TR]
[TR]
[TD="width: 64"]a1[/TD]
[TD="width: 64"]1234[/TD]
[TD="width: 64"]packed[/TD]
[TD="width: 64"]12[/TD]
[/TR]
[TR]
[TD="width: 64"]a2[/TD]
[TD="width: 64"] [/TD]
[TD="width: 64"]picked[/TD]
[TD="width: 64"] [/TD]
[/TR]
[TR]
[TD="width: 64"]a3[/TD]
[TD="width: 64"]1121[/TD]
[TD="width: 64"] [/TD]
[TD="width: 64"]5[/TD]
[/TR]
[TR]
[TD="width: 64"] [/TD]
[TD="width: 64"]1212[/TD]
[TD="width: 64"]despatched[/TD]
[TD="width: 64"]12[/TD]
[/TR]
[TR]
[TD="width: 64"] [/TD]
[TD="width: 64"]43445[/TD]
[TD="width: 64"]received[/TD]
[TD="width: 64"]10[/TD]
[/TR]
[TR]
[TD="width: 64"] [/TD]
[TD="width: 64"]3333[/TD]
[TD="width: 64"]packed[/TD]
[TD="width: 64"]5[/TD]
[/TR]
[TR]
[TD]aaaa[/TD]
[TD]AARAV[/TD]
[TD]PACKED[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]vvv[/TD]
[TD]DEEPAK[/TD]
[TD]PACKED[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]ddd[/TD]
[TD]C[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]eee[/TD]
[TD]D[/TD]
[TD] [/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]PACKED[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]ghhh[/TD]
[TD] [/TD]
[TD]PACKED[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Z[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]X[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]C[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]V[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD]G[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD]N[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
</tbody>[/TABLE]

RESULT I ACTUALLY GET

[TABLE="class: grid, width: 274"]
<colgroup><col><col span="3"></colgroup><tbody>[TR]
[TD]PO NUMBER[/TD]
[TD]PART NUMBER[/TD]
[TD]STATUS[/TD]
[TD]QUANTITY[/TD]
[/TR]
[TR]
[TD]a1[/TD]
[TD]1234[/TD]
[TD]packed[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]a2[/TD]
[TD] [/TD]
[TD]picked[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]a3[/TD]
[TD]1121[/TD]
[TD] [/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]aaaa[/TD]
[TD]1212[/TD]
[TD]despatched[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]vvv[/TD]
[TD]43445[/TD]
[TD]received[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]ddd[/TD]
[TD]3333[/TD]
[TD]packed[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]eee[/TD]
[TD]AARAV[/TD]
[TD]PACKED[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]DEEPAK[/TD]
[TD]PACKED[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]ghhh[/TD]
[TD]C[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]D[/TD]
[TD] [/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]Z[/TD]
[TD]PACKED[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]X[/TD]
[TD]PACKED[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]C[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD]V[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD]G[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]N[/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]RECEIVED[/TD]
[TD]8[/TD]
[/TR]
</tbody>[/TABLE]

Hope this will explain my problem. sorry to be a pain.
 
Upvote 0
See is this mod will work for you.

Code: 
Sub Get_Info_By_Headers2()
    Dim sPath As String
    Dim sFil As String
    Dim owb As Workbook
    Dim twb As Workbook
    Dim ch
    Dim j As Long, a As Long, lr As Long
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    ch = Array("po number", "part number", "status", "quantity")
    Set twb = ThisWorkbook
    sPath = "C:\Users\dipak\Desktop\CRASH REPORT\"
    sFil = Dir(sPath & "*.xl*")
    Do While sFil <> "" And sFil <> twb.Name
        Set owb = Workbooks.Open(sPath & sFil)
            With owb.Sheets("data")
                lr = twb.Sheets("report").Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1
                For j = LBound(ch) To UBound(ch)                    
                    a = .Rows(1).Find(ch(j), , , 1).Column
                    .Range(.Cells(2, a), .Cells(.Cells(.Rows.Count, a).End(xlUp).Row, a)).Copy twb.Sheets("report").Cells(lr, j + 1)
                Next j
            End With
        owb.Close False 'Close no save
        sFil = Dir
    Loop
    With Application
        .Calculation = xlAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
Last edited:
Upvote 0
JLGWhiz said:
Glad you could use it,
regards, JLG
Click to expand...

Sorry for being greedy but is it possible if I want to include the name of the file from where the data is being taken to be included in one of the columns?

I feel you will definitely have the solution.

Thanks.
 
Upvote 0
Hi all

I was able to get the result (close to what I want not exact) by the following code.

Currently it is only putting the file name in bh2 to bh10. How can i make it put the file name in Bh2 to till the last active row of the sheet?

owb.Sheets("data").Range("bh2:bh10").Value = owb.Name


Code: 
Sub Get_Info_By_Headers()
    Dim sPath As String
    Dim sFil As String
    Dim owb As Workbook
    Dim twb As Workbook
    Dim ch
    
    
    Dim j As Long, a As Long
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    ch = Array("po number", "part number", "status", "quantity", "project")
    Set twb = ThisWorkbook
    sPath = "C:\Users\dipak\Desktop\CRASH REPORT\"
    sFil = Dir(sPath & "*.xl*")
    Do While sFil <> "" And sFil <> twb.Name
        Set owb = Workbooks.Open(sPath & sFil)
            With owb.Sheets("data")
            owb.Sheets("DATA").Cells(1, 60) = "project"
            'owb.Sheets("DATA").Cells(2, 60) = owb.Name
            owb.Sheets("data").Range("bh2:bh10").Value = owb.Name
            
            
                lr = twb.Sheets("report").Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1
                For j = LBound(ch) To UBound(ch)
                    a = .Rows(1).Find(ch(j), , , 1).Column
                    .Range(.Cells(2, a), .Cells(.Cells(.Rows.Count, a).End(xlUp).Row, a)).Copy twb.Sheets("report").Cells(lr, j + 1)
                    
                    Next j
            End With
        owb.Close False 'Close no save
        sFil = Dir
    Loop


    With Application
        .Calculation = xlAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Unable to find error in code - Runtime 1004 error.
Replies
4
Views
735
Justplainj
J
J
  • Solved
Macro button movig to new sheet
Replies
2
Views
644
smozgur
smozgur
J
  • Solved
VBA to Open workbook and run macro
Replies
4
Views
2K
rollis13
rollis13
D
  • Question Question
VBA to check 2 cells of data and then copy and paste from multiple sheets to the data sheet
2
Replies
11
Views
406
danbates77
D
BAKELOVEMORE
  • Question Question
Find value in sheet1, copy offset value, find offset value in sheet 2, paste text in offset cell
Replies
1
Views
271
offthelip
O

Forum statistics

Threads
1,223,239
Messages
6,170,947
Members
452,368
Latest member
jayp2104

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