Extract a column of text from 290 sheets


New Member
Sep 14, 2017

This is my first post on this forum. I have been tasked with compiling data from the same column in many sheets (290).
-The sheets are all in the same workbook and have an incremental name (SO17000-SO17290).
-The column contains data that looks like this: 6129/110

I need to compile how many iterations there are of each individual data entry in the range $E$21:$E$61

Furthermore, I'd need to be able to tell if the value that is in the field to the right ($F$21:$F$61) is different than N/A or TBA.

This all looks too complicated and I feel somewhat desperate so any help will be welcome.

Thank you

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.


Well-known Member
Oct 18, 2007
Office Version
Welcome to the forums !

The below code will not do exactly what you need but it will create a new sheet & put all the data that you need to check in one place which should make your job much easier. If you still struggle, let us know we will help you further

Sub test()

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

' Add new sheet to gather all the necessary data from all sheets in 1 place
Worksheets.Add.Name = "Check Data Sheet"

' Setting up the header names in the new created sheet
With Sheets("Check Data Sheet")
    .Range("A1").Value = "Sheet Name"
    .Range("B1").Value = "Value/Code"
    .Range("C1").Value = "Right Field"
End With

Dim lRow As Long, i As Long
lRow = Sheets("Check Data Sheet").Range("A" & Rows.Count).End(xlUp).Row

' This part will go through all sheets & link the data you need to the newly created sheet
Dim ws As Worksheet
For Each ws In Worksheets
    If ws.Name <> "Check Data Sheet" Then
        For i = 21 To 61
            With Sheets("Check Data Sheet")
                .Cells(lRow + 1, 1).Value = ws.Name
                .Cells(lRow + 1, 2).Value = "='" & ws.Name & "'!E" & i
                .Cells(lRow + 1, 3).Value = "='" & ws.Name & "'!F" & i
            End With
            lRow = lRow + 1
        Next i
    End If

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub


Well-known Member
Jun 24, 2015

Welcome to the Board.

Another vba approach...

Sub CompileIterations_1022804()
Dim wb1 As Workbook, wb2 As Workbook
Dim i As Long, j As Long, r As Long, c As Long, nSheets As Long, nCells As Long
Dim Data As Variant, DataAll As Variant, DataFinal As Variant, dic As Object

Set wb1 = ThisWorkbook
''''Determine number of sheets and number of cells
nSheets = wb1.Sheets("SO17290").Index - wb1.Sheets("SO17000").Index + 1
nCells = wb1.Sheets("SO17000").Range("E21:E61").Rows.Count

j = 0
ReDim DataAll(1 To nSheets * nCells, 1 To 3)
''''Loop through sheets and compile Data into DataAll array
For i = wb1.Sheets("SO17000").Index To wb1.Sheets("SO17290").Index
    Data = wb1.Sheets(i).Range("E21:F61")
        For r = 1 To nCells
            For c = 1 To 2
                If j <> 0 And r + j <= nSheets * nCells Then
                    DataAll(r + j, 1) = wb1.Sheets(i).Name
                    DataAll(r + j, c + 1) = Data(r, c)
                    DataAll(r, 1) = wb1.Sheets(i).Name
                    DataAll(r, c + 1) = Data(r, c)
                End If
            Next c
        Next r
        j = j + nCells
Next i

Set wb2 = Workbooks.Add
''''Write DataAll to new workbook
wb2.Sheets(1).Range(wb2.Sheets(1).Cells(1, 1), wb2.Sheets(1).Cells(UBound(DataAll), 3)).Value = DataAll

''''Loop through DataAll, add items to dictionary and increment number of iterations
Set dic = CreateObject("Scripting.Dictionary")
For r = 1 To UBound(DataAll, 1)
    dic.Item(DataAll(r, 2)) = dic.Item(DataAll(r, 2)) + 1
Next r

ReDim DataFinal(0 To dic.Count - 1, 1 To 2)
''''Copy dictionary to DataFinal array
For i = 0 To dic.Count - 1
    DataFinal(i, 1) = dic.keys()(i)
    DataFinal(i, 2) = dic.items()(i)
Next i
''''Write DataFinal array to new workbook
With wb2.Sheets(1)
    .Cells(1, 5).Value = "Unique Data Values"
    .Cells(1, 6).Value = "Iterations"
    .Range(wb2.Sheets(1).Cells(2, 5), wb2.Sheets(1).Cells(dic.Count + 1, 6)).Value = DataFinal
End With
End Sub
Similar to the macro provided by mse330, this code compiles all the data into a single sheet in a new workbook. It then goes on to list the unique values and their corresponding iterations.

Furthermore, I'd need to be able to tell if the value that is in the field to the right ($F$21:$F$61) is different than N/A or TBA.
It's not clear to me how you want this information displayed.

If you're new to vba, please see the contextures tutorial on how to add code to a workbook.


Last edited:

Watch MrExcel Video

Forum statistics

Latest member

This Week's Hot Topics