excel - Convert Formula to VBA

Question

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
  

Answer 1

There are a couple of mashup between using a formula as a VBA WorksheetFunction object and writing a formula in a worksheet cell.

Your use of emptycolumn2letter has a couple of issues. As mentioned by user3714330 in comments, it doesn't appear to be a complete cell reference; just the column letter. .Range("C2") or .Range("C:C") is valid. .Range("C") is not. Additionally, once emptycolumn2letter has a valid cell address, you do not quote it; e.g. .Range(emptycolumn2letter) not .Range("emptycolumn2letter"). You would only use the latter is emptycolumn2letter was a named rage on the worksheet. It is not; it is a variable within the VBA procedure.

Similarly, ws1 cannot be used unless the name of the worksheet was literally ws1 which it does not appear to be. You need to break hte formula string up and use ws1.name concatenated inside the formula string.

On a related note, it is always good practise to use single quotes wrapped around worksheet names when constructing formulas from strings. If the worksheet name contains no spaces they are not needed but do no harm if included. If they are needed and not there, the formula breaks.

dim ec2L as string, p1cv as string, p2cv as string, p3cv as string, vcl as string
ec2L = "Z3"
vcl = "$D$2:$D$1112"
p1cv = "$A$2:$A$1112"
p2cv = "$C$2:$C$1112"
p3cv = "$B$2:$B$1112"
With ws2
    'formula to duplicate:
    '[INDEX($D$2:$D$1112, MATCH(1, ($A$2:$A$1112=$U$7)*($C$2:$C$1112=$W$7)*($B$2:$B$1112=F3), 0))]
    .Range(ec2L).FormulaArray = _
      "=INDEX('" & ws1.name & "'!" & vcl & ", " & _
        "MATCH(1, ('" & ws1.name & "'!" & p1cv & "=" & condition1 & ")*" & _
                 "('" & ws1.name & "'!" & p2cv & "=" & condition2 & ")*" & _
                 "('" & ws1.name & "'!" & p3cv & "=" & condition3 & "), 0))
    .Range(ec2L) =  .Range(ec2L).value    
End With 

That is not completely 'turn-key' correct as there were a number of faluts above this code in your sub procedure but it should give you an idea of what to strive towards. Note that condition1, condition2 and condition3 are being treated as numbers. If they are text then they need to be wrapped in quotes as well.

You might find that using a cell's Address property with external:=true is a more convenient method of getting the worksheet names and cell addresses into the formula in one piece.