VBA macro that selects range of cells WITH data and uses that as range to insert formulas in another worksheet?

[Event2020]

Excel 2016



Hi

I have asked this question on a different forum but the user was unable to help..Here

I am not that proficient in VBA and I am doing my best to learn.

I have a workbook with two worksheets, “Sheet_1” and “Sheet_2”.

I am trying to write a VB macro that, if the condition “is not blank” is met on “Sheet_1” inserts a formula into a specific range of cells on “Sheet_2” worksheet.

How I would like it to work is the macro finds the first and last cells with data in “Sheet 1” Column A and use that to specify the range on “Sheet 2” Column A into which to enter the formula copied down the number of rows identified by the range from “Sheet_1”.

So if “Sheet 1” Column A has data in Cells A1 – A100 then the VB macro with enter the formula in “Sheet 2” Column A Cells A2 – A101 and then stop or exit. The formula should auto number the numeric references in the same way that it would if it was copied down manually. Sheet 2 has a header row hence the one row offset (A2 – A101)

I will need 8 different formulas, each entered in the 2nd row, of Columns A - H with the macro all using the same criteria to decided how many times down a column it should insert (if “Sheet 1” Column A has data in Cells A1 – A100 then the VB macro with enter the formula in “Sheet 2” Column A Cells A2 – A101 and then stop or exit.)

By this I mean:
Formula 1 goes into 2nd row of Column A
Formula 2 goes into 2nd row of Column B
Formula 3 goes into 2nd row of Column C
and so on.

For now I am trying to get it to just work on Formula 1 which seems a hard enough task for me before adding all 8 to the macro.

This is the code I have so far but I cannot get it to work.

Sub InsertFormulasTest()
Dim Answer As VbMsgBoxResult
Dim xRow As Long
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Answer = MsgBox("Insert Formula", vbYesNo, "Insert formula test")

If Answer = vbYes Then
Application.ScreenUpdating = False

xRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws2.Range("A1:A").CurrentRegion.ClearContents
xRow = 1

ws2.Range("A2:A10").Formula = "=IF(Sheet1A1>"""", ""Has Data"",""No Data"")"

End If

End Sub

This is above my skill level and I am unable to work out why the code is not working.

 

[offthelip]

You haven't said what your other equations are but here is the first one:

Sub test()
' define a double quote constant . this to be clear as where double quotes are entered in the string
tt = Chr(34)
With Worksheets("Sheet1")
 lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Sheet2")
 outarr = Range(.Cells(1, 1), .Cells(lastrow, 8))
 
For i = 2 To lastrow
'"=IF(Sheet1!A1>"""", ""Has Data"",""No Data"")"
 
 ' formula 1
  outarr(i, 1) = "=IF(Sheet1!A" & i & "<>" & tt & tt & ", " & tt & "Has Data" & tt & "," & tt & "No Data" & tt & ")"
Next i
' write the output to the range
 Range(.Cells(1, 1), .Cells(lastrow, 8)).Formula = outarr
 
End With
End Sub

The output array is set up to add the other equations in

 

[Event2020]

offthelip

Thank you for your amazing help.

The code works perfectly except that when it inserts the formulas into Sheet 2 it is leaving out the first row of formulas rather than starting the array result in row 2 of Sheet 2.

To explain it another way - as an example if there is data in cells A1 - A4 of Sheet 1.

Formula 1 should be inserted in Sheet 2. A2 - A5.

The code at the moment is inserting the formula at A2 - A4

I hope I am explaining properly

Your code where you have set it up for further formulas is really easy for me to understand and I have been able to add two more test formulas really quickly.
Again, thank you, absolutely brilliant.

I did not provide any other equations in my post as I have not finished writing them. I stopped when I could not get the code to even enter a simple dummy formula so I wanted to get the code working first and thanks to you adding further equations seems straight forward.

I did not know that you can define a double quote as a constant, that is genius and will make life so much easier.
So thank you for teaching me that also and I mean that.

 

[offthelip]

try this simple change so that sheet1 row1 is referenced by sheet2 row 2

Sub test()
' define a double quote constant . this to be clear as where double quotes are entered in the string
tt = Chr(34)
With Worksheets("Sheet1")
 lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Sheet2")
 outarr = Range(.Cells(1, 1), .Cells(lastrow + 1, 8))
 
For i = 1 To lastrow
'"=IF(Sheet1!A1>"""", ""Has Data"",""No Data"")"
 
 ' formula 1
  outarr(i + 1, 1) = "=IF(Sheet1!A" & i & "<>" & tt & tt & ", " & tt & "Has Data" & tt & "," & tt & "No Data" & tt & ")"
Next i
' write the output to the range
 Range(.Cells(1, 1), .Cells(lastrow, 8)).Formula = outarr
 
End With
End Sub

 

[Event2020]

@offthelip
Hi and thanks for that but the bottom row of the inserted formulas is now out of sync and missing out the last row with data from Sheet 1.
In the example below it is leaving out Row 11 on Sheet 2

 

[offthelip]

My mistake I forgot to change the statement writing out the output array when making the last change this statement:

' write the output to the range
 Range(.Cells(1, 1), .Cells(lastrow, 8)).Formula = outarr

to

' write the output to the range
 Range(.Cells(1, 1), .Cells(lastrow+1, 8)).Formula = outarr

 

[Event2020]

offthelip

Perfect. You sir are a gentleman.

Not only have you been patient and helped me, you have taught me a lot too.

Thank you.