Excel VBA Incrementing Range by one Row Loop

VBA_Novice_0797

New Member
Joined
Jun 7, 2020
Messages
7
Office Version
  1. 2016
Platform
  1. Windows
Hello,

This is my first post here so apologies in advance if I miss out anything or do not give enough detail!

I have a formatted output (range from worksheet) - that emails itself to me each time new data is added and macro is run. To create this I have adapted code that I have found online from Ron De Bruin to email a range which includes images (some charts and graphs).

The initial code works perfectly, however, the problem I am having is that there is constantly new data being added (this is added in the empty row below latest data) that is not being included in the output as the output is using a fixed range, i.e. ("A1:N10").

Effectively, I need this to offset itself by 1 each time the macro runs, i.e. first time range = ("A1:N10"), second time = ("A1:N11"), third time = ("A1:N12") and so on.

There are two references to the range in the code, initially in the sub and then within the function so I am unsure if both would need to be looped?

I think that the best way to do this is through a loop, however, I am not able to get it to work - please see extract of code with my current attempt below:

VBA Code:
Sub EmailCreation()
 
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim MakeJPG As String
                                  
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
                
        strbody = ""

    MakeJPG = CopyRangeToJPG("Output", "A1:N10")

....



VBA Code:
Function CopyRangeToJPG(Output As String, RangeAddress As String) As String
    Dim PictureRange As Range
    Dim i As Long
    
    With ActiveWorkbook
        On Error Resume Next
        
        .Worksheets("Output").Activate
        
        Set PictureRange = .Worksheets("Output").Range("A1:N10")
                              
            For i = 10 To 500
                PictureRange.Offset (PictureRange.Rows.Count + 1)
            Next i
               
    If PictureRange Is Nothing Then
        MsgBox "Picture Range is empty, please check data source"
        On Error GoTo 0
        Exit Function
    End If

....


I am not sure if I am on the right track or not and would appreciate any help or advice, if you need any more information just let me know!

Windows and Excel 2016.

Thanks,
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,527
Office Version
  1. 2019
Platform
  1. Windows
Hi,

Welcome to forum

You can dynamically size the required range in your main code & pass the address to the Function

See if these updates to Ron’s codes help you


Rich (BB code):
Sub EmailCreation()

    Dim OutApp As Object, OutMail As Object
    Dim strbody As String, MakeJPG As String
   
    Dim DataRange As Range
   
    With ThisWorkbook.Worksheets("OutPut")
        Set DataRange = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, "N").End(xlUp).Row, 14))
    End With
                     
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
               
        strbody = ""
       
        MakeJPG = CopyRangeToJPG(DataRange.Parent.Name, DataRange.Address)
       
        'rest of code

End Sub


VBA Code:
Function CopyRangeToJPG(ByVal NameWorksheet As String, ByVal RangeAddress As String) As String
'Ron de Bruin, 25-10-2019
    Dim PictureRange As Range


    With ActiveWorkbook
        On Error Resume Next
        .Worksheets(NameWorksheet).Activate
        Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
       
        If PictureRange Is Nothing Then
            MsgBox "Sorry this is not a correct range"
            On Error GoTo 0
            Exit Function
        End If
       
        'rest of code
       
        End With
End Function

You will note that I have returned from the hard-coded values you made Ron’s Function code to its original state – Whole point of parameters in a Function is that you are passing the required values to them from calling procedure which avoids the need to hard code.

My Personal approach would be to pass the range object variable as the sole argument to the Function as this carries the worksheet (parent) but if update works ok then best leave it as published by Ron

Also, just an aside, if you are using published codes, always a courtesy to the author to keep their name where shown in code.

If need further guidance, post back, plenty here to assist

Hope Helpful



Dave
 

VBA_Novice_0797

New Member
Joined
Jun 7, 2020
Messages
7
Office Version
  1. 2016
Platform
  1. Windows
Hi Dave,

I have just updated the code as you suggested and it works perfectly.

Thank you very much for your help and advice!
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,527
Office Version
  1. 2019
Platform
  1. Windows
Most welcome - glad suggestions helped

Many thanks for feedback

Dave
 

VBA_Novice_0797

New Member
Joined
Jun 7, 2020
Messages
7
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Hello all,

I attempting to expand on the code above so that the height of the image that is added to the email each time adapts to the height of the cell in which new data is added.

I am currently using a fixed range, height =500, which is leading to compression of data and not what I am after.

I need to be able to set height = NewHeight, where NewHeight is a variable that adds the height of new rows to the base height each time it is run.

I have written the code for 'NewHeight' in a separate Module, the code for this works and gives me a number which is updated each time, it is just a case of getting this number from the cell I paste it to, E20 to being recognised as the desired height for the HTML body.


VBA Code:
With OutMail

.To = Test@Test.com

.Subject = Height Adapt Test

.Attachments.Add MakeJPG, 1, 0

.HTMLBody = “<html><p>” & strbody & “</p><img src=””NamePicture.jpg”” width = 400 height = 500 ></html>”

.Display 

End With

I have tried to add a variable to act as the count in this code, with:
VBA Code:
 .HTMLBody = “<html><p>” & strbody & “</p><img src=””NamePicture.jpg”” width = 400 height = NewHeight ></html>”

This does not work.

I have also tried the below, with no success:

VBA Code:
 .HTMLBody = “<html><p>” & strbody & “</p><img src=””NamePicture.jpg”” width = 400 height = Worksheets("Home").Range("E20") ></html>”

I hope this makes sense and would be grateful for any suggestions or pointers on how to make the height variable, as opposed to fixed!

If I have been too vague, not given enough info or there is any issues with my post just let me know.

Thanks,
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,527
Office Version
  1. 2019
Platform
  1. Windows
Hi,
this is a new question - suggest you start a new thread where likely to get more responses - you can add a link back to this thread if question is relevant.

Dave
 

Watch MrExcel Video

Forum statistics

Threads
1,130,381
Messages
5,641,823
Members
417,239
Latest member
AymericA

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top