Pull Data from Sheet3 to Sheet1

[richardSmith]

Greetings Richard,

Try - In a Standard Module:

Option Explicit
  
  'Sheet 3 is in the format that my query is returning from. I need to somehow
  'programatically pull the data from my sheet3 into the correspodning and correct row on sheet1.
  
  'NOTE: 'Sheet 3' in your example file had a CodeName of 'Sheet2'.  I am using the CodeName.
  
Sub Example()
Private DIC         As Object ' Scripting.Dictionary
Dim rngDataLastCell As Range
Dim arrDataRaw      As Variant
Dim arrDataLayedOut As Variant
Dim Keys            As Variant
Dim y               As Long
Dim yRow            As Long
Dim x               As Long
Dim xCol            As Long
  
  With Sheet2
    
    '// Find last cell with data in Col A, from row 2 downward.                       //
    Set rngDataLastCell = RangeFound(.Range(.Cells(2, 1), .Cells(.Rows.Count, 1)))
    
    '// In case no data.                                                              //
    If rngDataLastCell Is Nothing Then
      MsgBox "No data...", vbInformation, vbNullString
      Exit Sub
    End If
    
    '// If we got here, we're good-to-go, so set a reference to a new dictionary and  //
    '// plunk the raw data into an array.                                             //
    Set DIC = CreateObject("Scripting.Dictionary")
    arrDataRaw = .Range(.Range("A2"), rngDataLastCell).Resize(, 3).Value
    
  End With
  
  '// Just build a collection of unique keys, we don't need the items.                //
  For y = 1 To UBound(arrDataRaw, 1)
    DIC.Item(arrDataRaw(y, 1)) = Empty
  Next
  
  '// Size an output array; I am presuming 'weeks' should run to 52.                  //
  ReDim arrDataLayedOut(1 To (5 * DIC.Count), 1 To 53)
  
  '// Plunk the dictionary Keys into an array (for late-binding).                     //
  Keys = DIC.Keys
  
  '// Looping through the Keys array, pre-fill our output array.                      //
  For y = 0 To UBound(Keys, 1)
    arrDataLayedOut(((y + 1) * 5) - 4, 1) = Keys(y)
    arrDataLayedOut(((y + 1) * 5) - 3, 1) = "Week #"
    For x = 1 To 52
      arrDataLayedOut(((y + 1) * 5) - 3, x + 1) = x
    Next
    arrDataLayedOut(((y + 1) * 5) - 2, 1) = "Count"
  Next
  
  '// Loop through the first 'column' of our raw data, grabbing and correctly placing //
  '// data into our output array.                                                     //
  For y = 1 To UBound(arrDataRaw, 1)
    yRow = Application.Match(arrDataRaw(y, 1), Application.Index(arrDataRaw, 0, 1), 0)
    xCol = Application.Match(arrDataRaw(y, 3), Application.Index(arrDataLayedOut, yRow + 1, 0), 0)
    arrDataLayedOut(yRow + 2, xCol) = arrDataRaw(y, 2)
  Next
  
  ThisWorkbook.Worksheets.Add(After:=Sheet2).Range("A1").Resize(UBound(arrDataLayedOut), UBound(arrDataLayedOut, 2)).Value _
    = arrDataLayedOut
  
End Sub
  
Function RangeFound(SearchRange As Range, _
                    Optional ByVal FindWhat As String = "*", _
                    Optional StartingAfter As Range, _
                    Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
                    Optional LookAtWholeOrPart As XlLookAt = xlPart, _
                    Optional SearchRowCol As XlSearchOrder = xlByRows, _
                    Optional SearchUpDn As XlSearchDirection = xlPrevious, _
                    Optional bMatchCase As Boolean = False) As Range
    
    If StartingAfter Is Nothing Then
        Set StartingAfter = SearchRange(1)
    End If
    
    Set RangeFound = SearchRange.Find(What:=FindWhat, _
                                      After:=StartingAfter, _
                                      LookIn:=LookAtTextOrFormula, _
                                      LookAt:=LookAtWholeOrPart, _
                                      SearchOrder:=SearchRowCol, _
                                      SearchDirection:=SearchUpDn, _
                                      MatchCase:=bMatchCase)
End Function

Hope that helps,

Mark

Is the Private DIC line a reference I need to add when I compile in Excel 2007 I get a compile error of invalid attribute in Sub or Function What dictionary reference would I need to add?

DISREGARD --
I changed the line of --- TO and it is functioning perfectly!
[vba]
Private DIC
Dim DIC
[/vba]