Excel 2016 VBA Macro to find range of cells with data on Sheet1 use that range to enter formula in range on Sheet2

Question

Excel 2016

Hi

I am not that proficient in VBA and I am doing my best to learn but I can only go so far before needing to ask for the kind help of those who are far more knowledgeable that me.

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 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). Just to clarify that at any one time the number of cells in Column A "Sheet_1" with data can vary from 1 cell to 1000 cells or more.

This is a screen shot of a mock up of the way the macro should work but I am open to betters ways of reaching the same result.

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

Answer 1

Hello Event2020

I am V. Arya, Independent Advisor, to work with you on this issue. Use this code

Sub x()
    Dim SWs As Worksheet, TWs As Worksheet
    Dim Lr As Long
    Dim Answer
    
    Set SWs = Worksheets("Sheet1")
    Set TWs = Worksheets("Sheet2")
    Lr = SWs.Range("A" & SWs.Rows.Count).End(xlUp).Row
    Answer = MsgBox("Insert Formula", vbYesNo, "Insert formula test")
    If Answer <> vbYes Then Exit Sub
    
    Application.ScreenUpdating = False
    
    TWs.Range("A2:A" & Lr + 1).Formula = "=IF(Sheet1!A1>"""", ""Has Data"",""No Data"")"
    
    Application.ScreenUpdating = True
End Sub

Answer 2

To:  Event2020

re:  vba code improvement

Try this...

'---

Sub InsertFormulasTest_R1()

  Dim Answer As VbMsgBoxResult

  Dim xRow As Long

  Dim ws As Worksheet

  Dim ws2 As Worksheet

 Set ws = ThisWorkbook.Worksheets("Sheet1")

 Set ws2 = ThisWorkbook.Worksheets("Sheet2")

 Answer = VBA.MsgBox("Insert Formulas in 2nd Worksheet ?  ", _

                  vbYesNo + vbQuestion, "Insert formula test")

  If Answer = vbYes Then

     Application.ScreenUpdating = False

     xRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

     ws.Range("A2:A" & xRow).Copy Destination:=ws2.Range("A2:A" & xRow)

  End If

End Sub

'---

Free Excel programs/workbooks at MediaFire (no ads)...

http://www.mediafire.com/folder/lto3hbhyq0hcf/Documents

Answer 3

Hi Event2020

I have a different approach to find a solution to your query

Using the worksheet change events you could achieve your goals without the need of inserting and clicking a button to run the macro.

The following codes will run each time Sheet1 is activated (selected) or deactivated

Please,

1- Right-click on the Sheet1 tab 

2- Select View Code

3-and paste the following codes on the sheet events VBA panel

Here is the code

*****************************************************************************************************

Private Sub Worksheet_Activate()

Dim DataRange As Range

Dim OutputSh As Worksheet

Dim datacell As Range

Set DataRange = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))

Set OutputSh = Sheets("Sheet2")

    For Each datacell In DataRange

                    OutputSh.Cells(datacell.Row + 1, datacell.Column).FormulaR1C1 = "=IF(Sheet1!R[-1]C<>"""",""Has Data"",""No Data"")"

    Next datacell

End Sub

Private Sub Worksheet_Deactivate()

Dim DataRange As Range

Dim OutputSh As Worksheet

Dim datacell As Range

Set DataRange = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))

Set OutputSh = Sheets("Sheet2")

    For Each datacell In DataRange

                    OutputSh.Cells(datacell.Row + 1, datacell.Column).FormulaR1C1 = "=IF(Sheet1!R[-1]C<>"""",""Has Data"",""No Data"")"

    Next datacell

End Sub

*********************************************************************************************

RESULTS

On Sheet2, Column B shows the formulas in column A

Notes:

You could try a similar code with the Worksheet_Change(ByVal Target As Range) event

every time you change the value in column A on Sheet1. ( You must add to the code a few more lines to specify the target range)

In the case, you would prefer to replace the formula with just the word "Has Data" or "No Data" then

*********************************************************************************************************

Private Sub Worksheet_Activate()

Dim DataRange As Range

Dim OutputSh As Worksheet

Dim datacell As Range

Set DataRange = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))

Set OutputSh = Sheets("Sheet2")

    For Each datacell In DataRange

            If Not IsEmpty(datacell) Then

                    OutputSh.Cells(datacell.Row + 1, datacell.Column).Value2 = "Has Data"

            Else

                    OutputSh.Cells(datacell.Row + 1, datacell.Column).Value2 = "No Data"

            End If

    Next datacell

End Sub

Private Sub Worksheet_Deactivate()

Dim DataRange As Range

Dim OutputSh As Worksheet

Dim datacell As Range

Set DataRange = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))

Set OutputSh = Sheets("Sheet2")

    For Each datacell In DataRange

            If Not IsEmpty(datacell) Then

                    OutputSh.Cells(datacell.Row + 1, datacell.Column).Value2 = "Has Data"

            Else

                    OutputSh.Cells(datacell.Row + 1, datacell.Column).Value2 = "No Data"

            End If

    Next datacell

End Sub

*********************************************************************************************

Do let me know if you need more help

On the other hand,

If the answer helped you.

Please, consider marking this thread as answered.

It would help others in the community with similar questions or problems.

Thank you in advance

Regards

Jeovany

Answer 4

Hello Event2020

I am V. Arya, Independent Advisor, to work with you on this issue. Use this code

Sub x()
    Dim SWs As Worksheet, TWs As Worksheet
    Dim Lr As Long
    Dim Answer
    
    Set SWs = Worksheets("Sheet1")
    Set TWs = Worksheets("Sheet2")
    Lr = SWs.Range("A" & SWs.Rows.Count).End(xlUp).Row
    Answer = MsgBox("Insert Formula", vbYesNo, "Insert formula test")
    If Answer <> vbYes Then Exit Sub
    
    Application.ScreenUpdating = False
    
    TWs.Range("A2:A" & Lr + 1).Formula = "=IF(Sheet1!A1>"""", ""Has Data"",""No Data"")"
    
    Application.ScreenUpdating = True
End Sub

Thank you for your suggestion and it works perfectly.

As I am still learning Excel VBA I found your code the most easy to understand.

Many thanks.