Amending this VBA code to read data from the last row of worksheet, rather than a set numbered row

[Dave Coram]

Hi!

Hope someone can help with the following:

The code below (with the help of Macropod - thanks again!) takes details from a single row of a worksheet (row 4) and puts them into relevant places of a Word template, then saves it.

Public Sub ExportToWord()
Dim WkSht As Worksheet
Set WkSht = ThisWorkbook.Worksheets(1)

Dim wrdApp As Object, wrdDoc As Object
Set wrdApp = CreateObject("Word.Application")
Const wdReplaceAll As Long = 2
Const wdNoProtection As Long = -1
Const wdAllowOnlyFormFields = 2

Dim StrPath As String, StrPwd As String
StrPath = "C:\Users\Dave\Desktop\"
StrPwd = "claire020781"

With wrdApp
    .Visible = True
    .Application.ScreenUpdating = False
     Set wrdDoc = .Documents.Add(StrPath & "NQT Assessment Record.dotx")
     With wrdDoc
        If .ProtectionType <> wdNoProtection Then .Unprotect Password:=StrPwd
        With .Range.Find
             .Text = "First Name"
             .Replacement.Text = WkSht.Range("B4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "Last Name"
             .Replacement.Text = WkSht.Range("C4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "DoB Date"
             .Replacement.Text = WkSht.Range("E4").Value & " " & _
                WkSht.Range("F4").Value & " " & WkSht.Range("G4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "TRefNo"
             .Replacement.Text = WkSht.Range("H4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "School Name"
             .Replacement.Text = WkSht.Range("A4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "DpP"
             .Replacement.Text = WkSht.Range("Y4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP1 Start"
             .Replacement.Text = WkSht.Range("AA4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP1 End"
             .Replacement.Text = WkSht.Range("AB4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP1 Due"
             .Replacement.Text = WkSht.Range("AC4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP2 Start"
             .Replacement.Text = WkSht.Range("AE4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP2 End"
             .Replacement.Text = WkSht.Range("AF4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP2 Due"
             .Replacement.Text = WkSht.Range("AG4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP3 Start"
             .Replacement.Text = WkSht.Range("AI4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP3 End"
             .Replacement.Text = WkSht.Range("AJ4").Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP3 Due"
             .Replacement.Text = WkSht.Range("AK4").Value
             .Execute Replace:=wdReplaceAll
          End With
        .Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=StrPwd
        .SaveAs (StrPath & WkSht.Range("C4").Value & " " & WkSht.Range("B4").Value & ".docx")
        .Close
    End With
    .Quit
End With
End Sub

I'd like to be able to amend it to be able to produce the Word document from the last populated row of the worksheet (could run it as part of the registration process for a new teacher) - please could someone help me?

I guess it would use 'LastRow', and turn the data cell references to something like '"B" & LastRow', but I'm not yet at a standard to be able to implement this.

In an ideal world, I'd also have a second macro, where I'm able to specify a specific row that I need to run a replacement Word document for (should any of their registered details change) - would this be possible? Isn't an essential if it's not - can work without this!

 

[Alan_P]

Hi Dave,

Delete the red text to have it work for the last row, or delete the blue text to have it work for a user inputted row...

Public Sub ExportToWord()
Dim WkSht As Worksheet
Set WkSht = ThisWorkbook.Worksheets(1)

Dim wrdApp As Object, wrdDoc As Object
Set wrdApp = CreateObject("Word.Application")
Const wdReplaceAll As Long = 2
Const wdNoProtection As Long = -1
Const wdAllowOnlyFormFields = 2

Dim StrPath As String, StrPwd As String
StrPath = "C:\Users\Dave\Desktop\"
StrPwd = "claire020781"

Dim LRw As Long
[COLOR=#0000ff]LRw = WkSht.Range("A" & Rows.Count).End(xlUp).Row[/COLOR]

[COLOR=#ff0000]Set LRw = Application.InputBox("Please enter a row number", "Row Select")[/COLOR]

With wrdApp
    .Visible = True
    .Application.ScreenUpdating = False
     Set wrdDoc = .Documents.Add(StrPath & "NQT Assessment Record.dotx")
     With wrdDoc
        If .ProtectionType <> wdNoProtection Then .Unprotect Password:=StrPwd
        With .Range.Find
             .Text = "First Name"
             .Replacement.Text = WkSht.Range("B" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "Last Name"
             .Replacement.Text = WkSht.Range("C" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "DoB Date"
             .Replacement.Text = WkSht.Range("E" & LRw).Value & " " & _
                WkSht.Range("F" & LRw).Value & " " & WkSht.Range("G" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "TRefNo"
             .Replacement.Text = WkSht.Range("H" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "School Name"
             .Replacement.Text = WkSht.Range("A" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "DpP"
             .Replacement.Text = WkSht.Range("Y" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP1 Start"
             .Replacement.Text = WkSht.Range("AA" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP1 End"
             .Replacement.Text = WkSht.Range("AB" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP1 Due"
             .Replacement.Text = WkSht.Range("AC" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP2 Start"
             .Replacement.Text = WkSht.Range("AE" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP2 End"
             .Replacement.Text = WkSht.Range("AF" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP2 Due"
             .Replacement.Text = WkSht.Range("AG" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP3 Start"
             .Replacement.Text = WkSht.Range("AI" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP3 End"
             .Replacement.Text = WkSht.Range("AJ" & LRw).Value
             .Execute Replace:=wdReplaceAll
             .Text = "IP3 Due"
             .Replacement.Text = WkSht.Range("AK" & LRw).Value
             .Execute Replace:=wdReplaceAll
          End With
        .Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=StrPwd
        .SaveAs (StrPath & WkSht.Range("C" & LRw).Value & " " & WkSht.Range("B" & LRw).Value & ".docx")
        .Close
    End With
    .Quit
End With
End Sub

Cheers,
Alan.

 

[Dave Coram]

Thanks, Alan - will give these a go!

 

[Dave Coram]

Hi Alan!

The last row macro works fine, but the specific row macro gives me an 'Compile Error - Object Required' message on the red line of text - please could you help?

Thanks!

Dave

 

[Alan_P]

My bad, didn't test it

Just remove the "Set", should work fine then I think