CODEWITHSUNDEEP
vbaexcel
Carson
Carson

Reputation: 33

Dynamically Pulling Rows of Data from a Dynamic Range

I have a spreadsheet that contains a large table of raw data pertaining to food ingredients. That data then has to be sorted for new ingredients, the old data cleared, and the new data populated.

The spreadsheet was originally setup so that the user would have to manually click a "Clear Data" button, followed by clicking a "Pull New Data" button on each individual tab. This workbook has dozens of tabs and is growing constantly as new ingredients are added.

I have setup a macro that goes through and clears out all of the data with a single run, but I am having trouble getting the sheet to dynamically sort and pull data to each individual worksheet. I could brute-force it by hard-coding the names each individual tab, but that would require updating the macro each time a new ingredient had to be added. I am looking to make this as dynamic as possible and feel that I am close.

Each ingredient sheet has the ingredient's corresponding material number in "A1", which is used as an identifier in the search.

The overall behavior I need from the spreadsheet is this: 1.) Compare the material number in the active sheet's A1 range to the first material number on the "Raw Data" sheet.

2.) If the active sheet's material number matches the material number in the current line, then copy the entire row on the Raw Data sheet to the Active Sheet.

3.)If these cells do not match, then move to the next row in the column and repeat until the end of the column.

4.) Activate the next sheet in the workbook and repeat the process until all sheets have been cycled through.

Below is the code that I currently have:

Sub PullNewData()

Dim wks As Worksheet
Set i = Sheets("Raw Data")
Set e = ActiveSheet
Dim d
Dim j
d = 20
j = 2

For Each wks In ActiveWorkbook.Worksheets

If wks.Name <> "Ingredient List" Then

    If wks.Name <> "Raw Data" Then

        If wks.Name <> "Instructions" Then

            wks.Activate

            For Each Cell In i.Range("B2:B10000")

            If i.Range("B" & j) = e.Range("A1") Then
            d = d + 1
            e.Rows(d).Value = i.Rows(j).Value

            End If
            j = j + 1
            Next Cell

        d = 20
        j = 2

        End If

    End If

End If

Next wks


End Sub

This code works for whatever sheet is activated (pulls correct data) and then cycles through the rest of the sheets without copying over any of those sheet's data. Can anyone tell me why this code is not copying to sheets that were not initially activated?

PS The triple IF statements near the beginning are to exclude three sheets from having their data sorted.

Upvotes: 2

Views: 188

Answers (1)

paul bica
paul bica

Reputation: 10715

This doesn't rely on ActiveSheet

Option Explicit

Public Sub PullNewData2()

    Const RAW_COL = 2           'B column in "Raw Data" ws
    Const THIS_LAST_ROW = 20    'last used row on current ws

    Dim ws As Worksheet, wsRaw As Worksheet, urRaw As Variant, r As Long

    Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
    urRaw = wsRaw.UsedRange

    Dim xclude As Variant, cellA1 As String, lr As Long, foundRow As Long
    xclude = Array("Ingredient List", "Raw Data", "Instructions")

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> xclude(0) And ws.Name <> xclude(1) And ws.Name <> xclude(2) Then
            foundRow = THIS_LAST_ROW
            cellA1 = Trim$(ws.Range("A1").Value2)
            For r = 2 To UBound(urRaw)
                If urRaw(r, RAW_COL) = cellA1 Then
                    foundRow = foundRow + 1
                    ws.Rows(foundRow).Value = wsRaw.Rows(r).Value
                End If
            Next r
        End If
    Next ws
End Sub

A faster way to do this is using AutoFilter

Option Explicit

Sub PullNewData3()
    Const RAW_COL = 2       'B column in "Raw Data" ws
    Const FIRST_ROW = 21

    Dim ws As Worksheet, wsRaw As Worksheet, xclude As Variant, cellA1 As String

    Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
    xclude = Array("Ingredient List", "Raw Data", "Instructions")
    optimizeXL True
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> xclude(0) And ws.Name <> xclude(1) And ws.Name <> xclude(2) Then
            cellA1 = Trim$(ws.Range("A1").Value2)

            With wsRaw.UsedRange
                If wsRaw.AutoFilterMode Then .AutoFilter    'clear filters
                .AutoFilter Field:=RAW_COL, Criteria1:=cellA1
                .Copy ws.Cells(FIRST_ROW, 1)
                ws.Cells(FIRST_ROW, 1).EntireRow.Delete     'if 1st row contains Headers
                .AutoFilter  'clear filter
            End With

        End If
    Next ws
    optimizeXL False
End Sub

Public Sub optimizeXL(Optional ByVal settingsOff As Boolean = True)
    With Application
        .ScreenUpdating = Not settingsOff
        .Calculation = IIf(settingsOff, xlCalculationManual, xlCalculationAutomatic)
        .EnableEvents = Not settingsOff
    End With
End Sub

Upvotes: 1

Related Questions