AmandaRae
AmandaRae

Reputation: 3

Pulling data from several worksheets and dropping into table on a summary worksheet (looping error)

I have created the code below to grab specific data from multiple sheets within the workbook, and placing them in rows on a summary sheet. It either populates nothing or populates every row over and over again. It needs to occur automatically.

Sub Summary()

    Dim WkSht as Worksheet
    Dim Row as Integer

    'A15 - A29: Pull over (A1) if > 0
    'B15 - B29: Pull over (C1) if > 0
    'C15 - C29: Pull over (D7) if > 0

    For Each WkSht In ThisWorkbook.Sheets
        For Row = 15 To 29
            If WkSht.Name Like "Tr. [0-9]*" Then
                If WkSht.Range("D7").Value > 0 Then
                    If IsEmpty(Row) Then
                        Cells(Row, 1).Value = WkSht.Range("A1").Value
                        Cells(Row, 2).Value = WkSht.Range("C1").Value
                        Cells(Row, 3).Value = WkSht.Range("D7").Value
                    End If
                End If
            End If
        Next Row
    Next WkSht
End Sub

Upvotes: 0

Views: 163

Answers (1)

Floris
Floris

Reputation: 46435

I suspect the following changes will help (a bit hard without seeing your entire workbook):

  1. Define the summary sheet as a separate entity - don't scrape data from it
  2. Instead of testing for isempty(Row), test for the thing you want to be empty (a cell? Row is a variable that you set a few lines earlier)
  3. Reference Cells on the summary sheet, not "by themselves". You can't be sure what Excel will be thinking (what sheet is active) when you do this.
  4. You are copying the same thing over and over again because of the For Row = loop inside the For Each loop. You just want to increment Row once for each worksheet found.

What you end up with is this - does that work?

Sub Summary()

    Dim WkSht as Worksheet
    Dim summarySheet as Worksheet
    Dim Row as Integer

    'A15 - A29: Pull over (A1) if > 0
    'B15 - B29: Pull over (C1) if > 0
    'C15 - C29: Pull over (D7) if > 0

    Set summarySheet = ThisWorkbook.Sheets("Summary") ' whatever the right name is…

    Row = 15
    For Each WkSht In ThisWorkbook.Sheets
        if Not (WkSht.Name = summarySheet.Name) Then
            If WkSht.Name Like "Tr. [0-9]*" Then
                If WkSht.Range("D7").Value > 0 Then
                    If IsEmpty(summarySheet.Cells(Row,1)) Then
                        summarySheet.Cells(Row, 1).Value = WkSht.Range("A1").Value
                        summarySheet.Cells(Row, 2).Value = WkSht.Range("C1").Value
                        summarySheet.Cells(Row, 3).Value = WkSht.Range("D7").Value
                    End If
                End If
            End If
            Row = Row + 1
        End If
    Next WkSht
End Sub

Your comment in the code suggests you want to move things if they are greater than zero only but your code only tests one value; did you intend to test all three?

Upvotes: 2

Related Questions