Through the help of the community here, I have constructed this piece of code where I sort through data based on certain criteria. My problem comes in the FormulaArray section, I have kind of a pseudo coded version of what I want the code to do now, but I'm not quite sure how to make it work 100% Any help is greatly appreciated. Thanks!
Sub BringData()
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wb3 As Workbook
Application.ScreenUpdating = False
Set wb1 = Workbooks.Open(ThisWorkbook.Path & "ook1-2.xlsm")
ThisWorkbook.Activate
Application.ScreenUpdating = True
wb1.SaveAs (ThisWorkbook.Path & "ook1-2copy.xlsm")
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "ook2.xlsm")
ThisWorkbook.Activate
Application.ScreenUpdating = True
Set wb3 = ThisWorkbook
Dim parameter1 As String
Dim condition1 As String
Dim parameter2 As String
Dim condition2 As String
Dim value As String
Dim ws2 As Worksheet
Dim ws1 As Worksheet
Set ws2 = wb2.Sheets(1)
Set ws1 = wb1.Sheets(1)
Dim destination1 As Worksheet
Dim destination2 As Worksheet
Dim emptyColumn1 As Long
Dim lastFullColumn1 As Long
Set destination1 = ws1
lastFullColumn1 = destination1.Cells(1, destination1.Columns.Count).End(xlToLeft).Column
If lastFullColumn1 > 1 Then
emptyColumn1 = lastFullColumn1 + 1
End If
Dim startrow As Range
Dim stoprow As Range
Dim l As Long
With wb3.Sheets("Sheet1")
Set startrow = .Columns("E").Find(What:="START", LookIn:=xlValues, lookat:=xlWhole)
Set stoprow = .Columns("E").Find(What:="STOP", LookIn:=xlValues, lookat:=xlWhole)
End With
For l = startrow.Row + 1 To stoprow.Row - 1
Application.ScreenUpdating = False
With wb3.Sheets("Sheet1")
parameter1 = .Cells(l, 6)
condition1 = .Cells(l, 7)
parameter2 = .Cells(l, 8)
condition2 = .Cells(l, 9)
value = .Cells(l, 10)
End With
With wb1.Sheets(1).Range(ws1.Cells(1, 1), ws1.Cells(1, lastFullColumn1))
Dim parameter1column As Range
Set parameter1column = .Find(What:=wb3.Sheets("sheet1").Cells(l, 6).value, LookIn:=xlValues, lookat:=xlWhole)
Dim parameter1columnLetter As String
parameter1columnLetter = ColumnLetter(parameter1column.Column)
Dim parameter2column As Range
Set parameter2column = .Find(What:=wb3.Sheets("sheet1").Cells(l, 8).value, LookIn:=xlValues, lookat:=xlWhole)
Dim parameter2columnLetter As String
parameter2columnLetter = ColumnLetter(parameter2column.Column)
Dim valuecolumn As Range
Set valuecolumn = .Find(What:=wb3.Sheets("sheet1").Cells(l, 10).value, LookIn:=xlValues, lookat:=xlWhole)
Dim valuecolumnLetter As String
valuecolumnLetter = ColumnLetter(valuecolumn.Column)
Dim lastFullcolumn2letter As String
Dim lastFullColumn2 As Long
Dim emptyColumn2 As Long
Dim emptycolumn2letter As String
Set destination2 = ws2
lastFullColumn2 = destination2.Cells(1, destination2.Columns.Count).End(xlToLeft).Column
If lastFullColumn2 > 1 Then
emptyColumn2 = lastFullColumn2 + 1
End If
lastFullcolumn2letter = ColumnLetter(lastFullColumn2)
emptycolumn2letter = ColumnLetter(emptyColumn2)
Dim patid1 As Range
Dim patid2 As Range
Set patid1 = wb1.Sheets(1).Range("D:D")
Set patid2 = wb2.Sheets(1).Range("D:D")
Dim parameter1columnvalue As Range
Set parameter1columnvalue = Columns(parameter1column.Column).Cells
Dim parameter2ColumnValue As Range
Set parameter2ColumnValue = Columns(parameter2column.Column).Cells
Dim valuecolumnValue As Range
Set valuecolumnValue = Columns(valuecolumn.Column).Cells
Dim i As Long
Dim k As Long
Dim m As Long
Dim Lookupstring As String
With ws2
.Range("emptycolumn2letter").FormulaArray = "=INDEX(ws1! valuecolumnletter:valuecolumnletter, MATCH(1, (ws1! parameter1columvalue= wb3.Sheets(1) condition1.value)*(ws1! parameter2columnvalue = wb3.Sheets(1) condition1.value)*(patid1=patid2), 0))"
.Range("emptycolumn2letter") = .Range("emptycolumn2letter").value
End With
End With
Application.ScreenUpdating = True
Next l
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox " This code ran in " & SecondsElapsed & "seconds", vbInformation
End Sub
The area I'm having trouble with is this:
With ws2
.Range("emptycolumn2letter").FormulaArray = "=INDEX(ws1! valuecolumnletter:valuecolumnletter, MATCH(1, (ws1! parameter1columvalue= wb3.Sheets(1) condition1.value)*(ws1! parameter2columnvalue = wb3.Sheets(1) condition1.value)*(patid1=patid2), 0))"
.Range("emptycolumn2letter") = .Range("emptycolumn2letter").value
End With
Edit
Dim lastFullRow1 As Long lastFullRow1 = destination1.Cells(destination1.Rows.Count, 1).End(xlUp).Row If lastFullRow1 > 1 Then emptyrow1 = lastFullRow1 + 1 End If Set destination2 = ws2 Dim lastFullRow2 As Long lastFullRow2 = destination2.Cells(ws2.Rows.Count, 1).End(xlUp).Row If lastFullRow2 > 1 Then emptyrow2 = lastFullRow2 + 1 End If Dim pasterange As String Dim patid As String Dim condition1s As String Dim condition2s As String Dim values As String pasterange = "lastfullcolumn2letter2:lastfullcolumn2letterlastfullrow2" patid = "D:D" condition1s = "parameter1columnletter1:parameter1columnletterlastfullrow1" condition2s = "parameter2columnletter1:parameter2columnletterlastfullrow1" values = "valuecolumnletter:valuecolumnletterlastfullrow1" MsgBox "column row " & condition1s With ws2 .Range(pasterange).FormulaArray = _ "=INDEX('" & ws2.Name & " '!' " & patid & ", " & _ "MATCH(1,('" & ws1.Name & "'!" & condition1s & "=" & condition1 & ")*" & _ "('" & ws1.Name & "'!" & condition2s & "=" & condition2 & ")*" & _ "('" & ws1.Name & "'!" & values & "=" & value & "),0))" .Range(pasterange) = .Range(pasterange).value End With
