Transfer data between matching headers

trux101

New Member
Joined
Feb 10, 2016
Messages
19
Can anyone help please, struggling to understand - If I run this code independently it works fine but when I incorporate it into a wider routine it is returning a runtime error 5 on the red highlighted section?

Dim rawSht As Worksheet
Dim procSht As Worksheet
Dim headers As Collection
Dim c As Long
Dim v As Variant

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False

Set rawSht = ThisWorkbook.Worksheets("Raw Data")
Set procSht = ThisWorkbook.Worksheets("Output Sheet")


Set headers = New Collection
For c = 1 To rawSht.Cells(1, Columns.Count).End(xlToLeft).Column
headers.Add c, rawSht.Cells(1, c).Text
Next

For c = 1 To 47
rawCol = headers(procSht.Cells(6, c).Text)
v = rawSht.Range(rawSht.Cells(2, rawCol), rawSht.Cells(Rows.Count, rawCol).End(xlUp)).Value2
procSht.Cells(7, c).Resize(UBound(v, 1)).value = v
Next

End With
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
What is the value of procSht.Cells(6, c) when the code errors?

The error indicates that this header wasn't previously found in row 1 of rawSht.

If the code works now, but errors if incorporated into wider code, I can only guess that the wider code is doing something unintended, e.g. perhaps accidentally overwriting your header area(s) with other values?
 
Upvote 0
Thanks @ StephenCrump - can't work it out still. The value of procSht.Cells(6, c) is blank when it errors.

The routine before that is opening a closed workbook and importing a worksheet into my current workbook. Once this is done, the above routine then starts the process of transferring the data from the imported sheet into the right columns on another worksheet.
 
Upvote 0
The value of procSht.Cells(6, c) is blank when it errors.

I am guessing that if you have no header value in procSht.Cells(6, c), then there is nothing to be copied from rawSht?
In which case, perhaps you could modify your code:

Code:
For c = 1 To 47
    If procSht.Cells(6, c).Text <> "" Then
        rawcol = headers(procSht.Cells(6, c).Text)
        v = rawSht.Range(rawSht.Cells(2, rawcol), rawSht.Cells(Rows.Count, rawcol).End(xlUp)).Value2
        procSht.Cells(7, c).Resize(UBound(v, 1)).Value = v
    End If
Next

Alternatively, if you have a blank header in procSheet, and there is a corresponding blank header in rawSht, and you want want to copy the matching column across to procSheet, then I suggest you check that the headers are in fact both blank. If the Collection key isn't a match, it would suggest that perhaps one header is "" and the other " ", or similar?
 
Upvote 0
Hasn't fixed it for some reason, thanks Stephen. Any other ideas on how I can achieve what I am aiming for?

Raw Data contains 47 columns and I would like to transfer data for all columns that headers are matched in Output Sheet.
 
Upvote 0
What is the value of c when you get the error?
 
Upvote 0
Rookie mistakes on my part – very new to VBA. The issue was that I was referring to more columns than containing headers in procSht so have made that dynamic. Thanks all for your help!

Const HDR1 As Long = 1 'header row on sheet 1
Const HDR2 As Long = 1 'header row on sheet 2

Dim ws1 As Worksheet, ur1 As Range, vr1 As Variant, c1 As Long, c2 As Long, r As Long
Dim ws2 As Worksheet, ur2 As Range, vr2 As Variant, msg As String, t As Double
Dim rawSht As Worksheet
Dim procSht As Worksheet
Dim headers As Collection
Dim c As Long
Dim v As Variant


Set rawSht = ThisWorkbook.Worksheets("Raw Data")
Set procSht = ThisWorkbook.Worksheets("Output")

Set headers = New Collection
For c = 1 To rawSht.Cells(1, Columns.Count).End(xlToLeft).Column
headers.Add c, rawSht.Cells(1, c).Text
Next

For c = 1 To procSht.Cells(1, Columns.Count).End(xlToLeft).Column
rawCol = headers(procSht.Cells(1, c).Text)
v = rawSht.Range(rawSht.Cells(1, rawCol), rawSht.Cells(Rows.Count, rawCol).End(xlUp)).Value2
procSht.Cells(1, c).Resize(UBound(v, 1)).value = v
Next
 
Upvote 0

Forum statistics

Threads
1,213,490
Messages
6,113,956
Members
448,535
Latest member
alrossman

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