Extract a column of text from 290 sheets

CarelessBeaver

New Member
Joined
Sep 14, 2017
Messages
2
Hello,

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
 

mse330

Active Member
Joined
Oct 18, 2007
Messages
449
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

Code:
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
Next

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

End Sub
 

tonyyy

Well-known Member
Joined
Jun 24, 2015
Messages
1,647
CarelessBeaver,

Welcome to the Board.

Another vba approach...

Code:
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)
                Else
                    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
    .Columns.AutoFit
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.

Cheers,

tonyyy
 
Last edited:

Forum statistics

Threads
1,082,017
Messages
5,362,695
Members
400,686
Latest member
Aakash

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top