title: Copy and compare specific cells to one sheet, in VBA Excel (Watch out mindbreaker!!)
body: <p>i have a quite specific question about programming in excel. I'm moderately skilled in VBA but can't get my head around this one.</p>
  
  <p>I have multiple sheets containing an list of id's and values. From these multiple sheets i want to make one complete sheet with values.</p>
  
  <p>Example:</p>
  
  <p>Sheet wk1</p>
  
  <pre><code>ID  - Var  - Var1  - Var 2
  
  10 - A - B - C
  
  14 - aa - bb- cc
  </code></pre>
  
  <p>Sheet wk2</p>
  
  <pre><code>ID  - Var  - Var1  - Var 2
  
  11 - d - e - f
  
  14 - AA - BB- CC
  </code></pre>
  
  <p>the function must make the following list</p>
  
  <p>Sheet combined</p>
  
  <p>ID - wk1(Var - Var 1 - Var 2) - wk2(Var - Var 1 - Var 2)</p>
  
  <pre><code>10 - A - B - C - - - 
  
  11 - - - - d - e - f
  
  14 - aa - bb - cc - AA - BB - CC
  </code></pre>
  
  <p>I hope this makes it clear...</p>
  
  <p>I think at first the function must define if every ID is present. And per iterated sheet copy values in the corresponding columns.</p>
  
  <p>Currently i have the following code for it to work. I must say it is under progress, but i need some pointers:</p>
  
  <pre><code>Sub getalldata()
  
  Dim MyPath As String, FilesInPath As String
  Dim MyFiles() As String
  Dim FNum As Long
  Dim mybook As Workbook
  Dim rnum As Long
  Dim ShName As Variant, BaseWks As Variant
  Dim rangearray As Variant
  
  ' Get all data from the eight excel files in the designated directory
  ' Compare Projnrs, an then paste values according in the designated slots
  '
  ' Path\folder location of the files.
  MyPath = ThisWorkbook.Path &amp; "/Source/"
  
  ' External sheet name. To get data from
  ShName = "Report"
  ' Range of columns to paste corresponding data too. sorted in per week eg {Wk1Val1, Wk1Val2 , Wk1Val3; Wk2Val1, Wk2Val2 , Wk2Val3 etc.
  rangearray = [{"D2","E2","F2";"G2","H2","I2";"J2","K2","L2";"M2","N2","O2";"P2","Q2","R2";"S2","T2","U2";"V2","W2","X2";"Y2","Z2","AA2"}]
  ' Internal sheet name. To paste data too
  ShName = "Report"
  
  
  ' Add a slash after MyPath if needed.
  If Right(MyPath, 1) &lt;&gt; "\" Then
      MyPath = MyPath &amp; "\"
  End If
  
  ' If there are no Excel files in the folder, exit.
  FilesInPath = Dir(MyPath &amp; "*.xl*")
  If FilesInPath = "" Then
      MsgBox "No files found"
      Exit Sub
  End If
  
  ' Fill the myFiles array with the list of Excel files in the
  ' folder.
  FNum = 0
  Do While FilesInPath &lt;&gt; ""
      FNum = FNum + 1
      ReDim Preserve MyFiles(1 To FNum)
      MyFiles(FNum) = FilesInPath
      FilesInPath = Dir()
  Loop
  
  ' Change application properties.
  With Application
      CalcMode = .Calculation
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableEvents = False
  End With
  
  rnum = 1
  
  'Sort array of max 8 excel files to get wk 1 results before wk2 reuslts
  BubbleSort MyFiles
  
  ' Loop through all files in the myFiles array.
  If FNum &gt; 0 Then
      For FNum = 0 To 7
          Set mybook = Nothing
          On Error Resume Next
          Set mybook = Workbooks.Open(MyPath &amp; MyFiles(FNum))
          On Error GoTo 0
  
          If Not mybook Is Nothing Then
  
              On Error Resume Next
              ' Set the filter range.
              ' Compare content and fill additional
  
  
                  For Each c In mybook.Worksheets("Report").Range(Cells(39, 3), Cells(65536, 3).End(xlUp)).Cells
                  If Not IsError(Application.Match(c.Value, Worksheets("Inputinfo").Range("A:A"), 0)) Then
                      ' String is in range, calculate values and paste accordingly
  
                      'Paste val1 ( Total profit (AQ+BA))
                      Worksheets("Inputinfo").Cells(c, 4 + FNum).Value = c.Offset(, 40).Value + c.Offset(, 50).Value
                      'Paste val2 (Not  yet allocated (K+BA-(R+AV))-(AQ+BA))
                      Worksheets("Inputinfo").Cells(c, 5 + FNum).Value = (c.Offset(, 8).Value + c.Offset(, 50).Value - (c.Offset(, 15).Value + c.Offset(, 45).Value)) - (c.Offset(, 40).Value + c.Offset(, 50).Value)
                      'Paste val3 (Net proj contri colum AT)
                      Worksheets("Inputinfo").Cells(c, 6 + FNum).Value = c.Offset(, 43).Value
                  Else
                      'String is not in range, take last used row to paste projnr and values in columns
  
                  End If
  
                  Next
  
              ' Close the workbook without saving.
              mybook.Close savechanges:=False
          End If
  
          ' Open the next workbook.
      Next FNum
  
  End If
  
  ' Restore the application properties.
  With Application
      .ScreenUpdating = True
      .EnableEvents = True
      .Calculation = CalcMode
  End With
  End Sub
  </code></pre>
  
  <p>Can somebody point me in the right direction?</p>
  
  <p>Kind regards,
  Mathijs</p>