Question - How to search through the first row for a column header, copy the data, paste into another sheet and also paste the worksheet name the data

[database_coder]

Hi All,

Thank you very much for everyone who has posted to this website. I have been using it for sometime now, and finally decided to make an account because I have a question that I can not seem to answer.

I have a Workbook consisting of 30 Worksheets. In each worksheet, my headers go from A1:Z1, but the number of observations are not consistent, meaning every worksheet has a different set of data. On each worksheet, I am only worried about the data in the Columns (Number, and Person), but the order is different throughout each worksheet.

What my goal here is - copy all the data for Number, and Person from each worksheet, and paste into a SUMMARY worksheet. Also, on each worksheet data is copied I need to save the name of the worksheet next to the data in the SUMMARY worksheet.

I know there is a way to copy the data all into an array, and paste to SUMMARY at the end. But I can not find a proper way to do it.

My code is a mess, which I have pasted below. Is there anyway we can do this? Any help will be most appreciated.

Sub B_IDs()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim sum As Worksheet
    Dim Leng As Long
    Dim x As Long
        Set sum = Sheets("Summary")
    
    sum.Cells.Clear
    
    Application.ScreenUpdating = False
    
    
    For Each ws In ActiveWorkbook.Worksheets
    Leng = ws.Range("A2").End(xlDown).Row + 1
        If ws.Name <> "Summary" Then
            If ws.Cells(1, 1).Value = "ID" Then
                ws.Range("A2:A100").Copy
                Worksheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
            End If
        End If
  
'        x = 1
'        For x = x To 20
'            If ws.Cells(1, x).Value = "PERSON" Then
'
'
''                Selection.Copy.Column
''                Worksheets("Summary").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
'            End If
'        Next x
    Next ws
    
   
        
End Sub

Sub WorksheetLoop()
    Dim wsCount As Integer
    Dim I As Integer
    Dim ws As Worksheet
    Dim RowCount As Long
    Dim x As Long
        
    wsCount = ActiveWorkbook.Worksheets.Count
    'RowCount = ActiveWorksheet.Count
    
    For Each ws In ActiveWorkbook.Worksheets
    
        For x = 1 To 100
            If Cells(x, "A") = "ID" And Cells(x, "F") = "PERSON" Then
                Cells(x, "A").Resize(, 3).Copy
                Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                Cells(x
            
            
            
            End If
            
        Next x
        
    Next ws

 

[hiker95]

database_coder,

Wow, I am astonished by how clean the code is and how successful it runs. Very good work.

Thanks for the feedback.

You are very welcome. Glad I could help.

Would it be possible to extend this one step further by stating Number to change columns between each worksheet.

It is not clear as to what you are asking. Please explain in more detail.

 

[database_coder]

Number	Name	Location
3	Ed	NYC
2	Bob	LA
10	Dylan	France

<tbody>
</tbody>

Name	Number	Location
Bob	1	Italy
Mark	4	NYC
Frank	6	LA

<tbody>
</tbody>

Location	Number	Name
NYC	7	Dylan
NYC	8	Michael
LA	19	Tom
NYC	13	Tim

<tbody>
</tbody>

Ok, Assume the above three tables are a worksheet in a workbook, table 1 is sheet1, table 2 is sheet2, and table 3 is sheet 3.
Would you be able to create a macro that copies Name and Number from each worksheet and pastes to the summary worksheet, with the worksheet name in column C.

Summary Worksheet would be organized as follows:

Number	Name	Worksheet Name

<tbody>
</tbody>

so that goes back to my question - assume Number is not in the same column in ever worksheet. Would you be able to create a macro that searched for the header Number (how you searched for Name in the macro you wrote), copied the data and pasted to summary worksheet with worksheet.name in column C.

 

[hiker95]

database_coder,

Sample worksheets before the macro:

Excel 2007
	B	C	D	E	F	G
1	Number		Name			Location
2	3		Ed			NYC
3	2		Bob			LA
4	10		Dylan			France
5
Sheet1

Excel 2007
	B	C	D	E	F
1		Name	Number		Location
2		Bob	1		Italy
3		Mark	4		NYC
4		Frank	6		LA
5
Sheet2

Excel 2007
	H	I	J	K	L	M
1		Location		Number		Name
2		NYC		7		Dylan
3		NYC		8		Michael
4		LA		19		Tom
5		NYC		13		Tim
6
Sheet3

Excel 2007
	A	B	C
1	Number	Name	Worksheet Name
2
3
4
5
6
7
8
9
10
11
12
Summary

After the macro in worksheet Summary:

Excel 2007
	A	B	C
1	Number	Name	Worksheet Name
2	3	Ed	Sheet1
3	2	Bob	Sheet1
4	10	Dylan	Sheet1
5	1	Bob	Sheet2
6	4	Mark	Sheet2
7	6	Frank	Sheet2
8	7	Dylan	Sheet3
9	8	Michael	Sheet3
10	19	Tom	Sheet3
11	13	Tim	Sheet3
12
Summary

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub GetNumberNameSheetName()
' hiker95, 02/09/2014, ME755957
Dim ws As Worksheet
Dim lr As Long, nurng As Range, narng As Range, nr As Long
Application.ScreenUpdating = False
With Sheets("Summary")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  If lr > 1 Then
    .Range("A2:C" & lr).ClearContents
  End If
End With
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Summary" Then
    With ws
      Set nurng = .Rows(1).Find("Number", LookAt:=xlWhole)
      Set narng = .Rows(1).Find("Name", LookAt:=xlWhole)
      If (Not nurng Is Nothing) * (Not narng Is Nothing) Then
        nr = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        lr = .Cells(Rows.Count, nurng.Column).End(xlUp).Row
        Sheets("Summary").Range("A" & nr).Resize(lr - 1).Value = .Range(.Cells(2, nurng.Column), .Cells(lr, nurng.Column)).Value
        Sheets("Summary").Range("B" & nr).Resize(lr - 1).Value = .Range(.Cells(2, narng.Column), .Cells(lr, narng.Column)).Value
        Sheets("Summary").Range("C" & nr).Resize(lr - 1).Value = ws.Name
      End If
    End With
  End If
Next ws
With Sheets("Summary")
  .Columns.AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetNumberNameSheetName macro.

 

[database_coder]

https://app.box.com/s/2k655mxi4f4ong4ivigf

I have provided another workbook, regarding my second question.

 

[database_coder]

Great job!

Question - what is the criteria range in this statement?

  If (Not nurng Is Nothing) * (Not narng Is Nothing) Then

Would it be possible to have a third, such as,

  If (Not nurng Is Nothing) * (Not narng Is Nothing) *(Not nirng Is Nothing) Then

changing the code to implement a third statement, and properly fixing the code?

 

[hiker95]

database_coder,

I just provided you with sample raw data based on your prior request.

Did you even read my reply #6?

Follow the instructions in reply #6, and, run the macro.

 

[hiker95]

database_coder,

We have done this exercise several times, and, each time, the raw data and your requirements change?

I had a problem trying to download your latest workbook.

One last try.

Please upload to BOX another workbook, containing several raw data worksheets with the titles in row 1, but, in different columns. And, in the Summary worksheet display the results you are looking for (manually formatted by you) from the raw data worksheets.

 

[database_coder]

Yes it does work! This is a great macro to have.

Sub GetNumberNameSheetName()
Dim ws As Worksheet
Dim lr As Long, nurng As Range, narng As Range, nr As Long
Dim nirng As Range
Application.ScreenUpdating = False
With Sheets("Summary")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  If lr > 1 Then
    .Range("A2:C" & lr).ClearContents
  End If
End With
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Summary" Then
    With ws
      Set nurng = .Rows(1).Find("Number", LookAt:=xlWhole)
      Set narng = .Rows(1).Find("Name", LookAt:=xlWhole)
      Set nirng = .Rows(1).Find("Location", LookAt:=xlWhole)
      If (Not nurng Is Nothing) * (Not narng Is Nothing) * (Not nirng Is Nothing) Then
        nr = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        lr = .Cells(Rows.Count, nurng.Column).End(xlUp).Row
        Sheets("Summary").Range("A" & nr).Resize(lr - 1).Value = .Range(.Cells(2, nurng.Column), .Cells(lr, nurng.Column)).Value
        Sheets("Summary").Range("B" & nr).Resize(lr - 1).Value = .Range(.Cells(2, narng.Column), .Cells(lr, narng.Column)).Value
        Sheets("Summary").Range("C" & nr).Resize(lr - 1).Value = .Range(.Cells(2, nirng.Column), .Cells(lr, nirng.Column)).Value
        Sheets("Summary").Range("D" & nr).Resize(lr - 1).Value = ws.Name
      End If
    End With
  End If
Next ws
With Sheets("Summary")
  .Columns.AutoFit
  .Activate
End With
Sheets("Summary").Cells(1, 1).Value = "Number" 'Column A Header
Sheets("Summary").Cells(1, 2).Value = "Name" 
Sheets("Summary").Cells(1, 3).Value = "Location"
Application.ScreenUpdating = True
End Sub

Hiker do you know how many variables this can hold?

 

[hiker95]

database_coder,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

Hiker do you know how many variables this can hold?

Probably as many as you need to solve a particular problem. And, as long as all the titles are on the same row.

But, the title row in any worksheet could be in different row?????

So far I have not run into that problem.

You could search in the woksheet's .UsedRange to find where the first title is, and, proceed from there.