Pull Data from Sheet3 to Sheet1

[richardSmith]

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. Can someone help me with thsi?
See my attachment for further DayCareNumbers.xlsx

Thanks to all and cheers

[GTO]

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

[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]

[GTO]

OOpsie! Sorry about that; i forgot to change it when moving it from module-level to procedure-level. Glad it's now working :-)

[richardSmith]

OOpsie! Sorry about that; i forgot to change it when moving it from module-level to procedure-level. Glad it's now working :-)

Hello m8 if I expand the data that is on sheet2 I get a Type Mismatch error --- Since I marked this thread as solved I opened a new one here:

http://www.vbaexpress.com/forum/show...other&p=304413

Can you please advice once you get a moment to review. Thanks in advance -- Rich