Mailmerge Excel to Excel

[welshgasman]

Hi everyone,

I need to create a mailmerge from Excel and use Excel for the mailmerge.

I discovered the code below from Mail Merge in Excel - Microsoft: Office FAQ - Tek-Tips

Function RangeName(sName As String) As String
    RangeName = Application.Substitute(sName, " ", "_")
End Function
Sub MergePrint()
'set up your merge form by naming the merge fields _
 with the same name as the data fields you are importing.
'if any data field contains spaces, then substitute an _
 UNDERSCORE character for each space in the name.
    Dim wsForm As Worksheet, wsData As Worksheet
    Dim sRngName As String, r As Long, c As Integer
    Set wsForm = Worksheets("My Form") 'change to your sheet name
    Set wsData = Worksheets("My Data") 'change to your sheet name
    With wsData.Cells(1, 1).CurrentRegion
        For r = 2 To .Rows.Count
            If Not wsData.Cells(r, 1).EntireRow.Hidden Then
                For c = 1 To .Columns.Count
                    sRngName = wsData.Cells(1, c).Value
                    Range(RangeName(sRngName)).Value = wsData.Cells(r, c)
                Next
                wsForm.PrintOut
            End If
        Next
    End With
End Sub

which works great and I have amended to save each sheet as the mailmerged file.

However it has a drawback where it expects a named range for every header name in the Data sheet.
I have more headers than named ranges required on the Excel form, as I need extra info on the mailmerge, date created, combining several columns etc.

I know how to hide the columns I am not using in the merge, but what would I need to change to only process visible columns?

TIA

 

[welshgasman]

Really surprised, no one chipped in on this one.
I've found a solution, not particularly elegant, but it works.

                strColName = fnColumnToLetter(c)
                    If ActiveSheet.Range(strColName & ":" & strColName).EntireColumn.Hidden = False Then
                        sRngName = wsData.Cells(1, c).Value
                        Workbooks(strTemplate).Sheets("Invoice").Range(RangeName(sRngName)).Value = wsData.Cells(r, c)
                    End If
                Next

and

' Get column letter from number
Function fnColumnToLetter(ByVal ColumnNumber As Integer)
fnColumnToLetter = Replace(Replace(Cells(1, ColumnNumber).Address, "1", ""), "$", "")
End Function

The function was obtained from VBA Column Number to Name-Explained with Excel Examples

 

[shg]

Late to the party, but you don't need those extra functions:

Sub MergePrint()
  ' set up your merge form by naming the merge fields _
    with the same name as the data fields you are importing.
  ' if any data field contains spaces, then substitute an _
    UNDERSCORE character for each space in the name.

  Dim wksForm       As Worksheet
  Dim wksData       As Worksheet
  Dim rInp          As Range
  Dim iRow          As Long
  Dim iCol          As Long

  Set wksForm = Worksheets("My Form")  'change to your sheet name
  Set wksData = Worksheets("My Data")  'change to your sheet name

  With wksData
    Set rInp = .Range("A1").CurrentRegion
    For iRow = 2 To rInp.Rows.Count
      If Not .Rows(iRow).Hidden Then
        For iCol = 1 To rInp.Columns.Count
          If Not Columns(iCol).Hidden Then
            Range(Replace(.Cells(1, iCol).Value, " ", "_")).Value = .Cells(iRow, iCol).Value
          End If
        Next iCol
        wksForm.PrintOut
      End If
    Next
  End With
End Sub

EDIT: This reference

Range(Replace(....

... is not qualified. Does the named range have workbook scope?

 

[welshgasman]

shg,
I'm always up for tidying code.
The original code expected the merge and data sheets to be in the same workbook.
I realised I needed a template due to formatting and pictures in the output workbook.

So for that reason I created a template which I open at the start and save with different names each time.
So, if I understand you correctly, yes it does, the scope is the workbook whose name is in strTemplate.

Workbooks(strTemplate).Sheets("Invoice").Range(RangeName(sRngName)).Value = wsData.Cells(r, c)

I'm off on holiday Wednesday, so doubt I will get a chance to test your version until my return.

Thank you for posting.

 

[MALEPINZON]

Hi, I'm so much interested in this case, I'd like to see the columns I am not using in the merge so I really need this colums remains in de Data sourse,

Late to the party, but you don't need those extra functions:

Sub MergePrint()
  ' set up your merge form by naming the merge fields _
    with the same name as the data fields you are importing.
  ' if any data field contains spaces, then substitute an _
    UNDERSCORE character for each space in the name.

  Dim wksForm       As Worksheet
  Dim wksData       As Worksheet
  Dim rInp          As Range
  Dim iRow          As Long
  Dim iCol          As Long

  Set wksForm = Worksheets("My Form")  'change to your sheet name
  Set wksData = Worksheets("My Data")  'change to your sheet name

  With wksData
    Set rInp = .Range("A1").CurrentRegion
    For iRow = 2 To rInp.Rows.Count
      If Not .Rows(iRow).Hidden Then
        For iCol = 1 To rInp.Columns.Count
          If Not Columns(iCol).Hidden Then
            Range(Replace(.Cells(1, iCol).Value, " ", "_")).Value = .Cells(iRow, iCol).Value
          End If
        Next iCol
        wksForm.PrintOut
      End If
    Next
  End With
End Sub

EDIT: This reference

Range(Replace(....

... is not qualified. Does the named range have workbook scope?

Hello, I'm not an expert, so I don't understand why this error happen . Could you give me a more detailed example?


Miguel P

 

[MALEPINZON]

Really surprised, no one chipped in on this one.
I've found a solution, not particularly elegant, but it works.

                strColName = fnColumnToLetter(c)
                    If ActiveSheet.Range(strColName & ":" & strColName).EntireColumn.Hidden = False Then
                        sRngName = wsData.Cells(1, c).Value
                        Workbooks(strTemplate).Sheets("Invoice").Range(RangeName(sRngName)).Value = wsData.Cells(r, c)
                    End If
                Next

and

' Get column letter from number
Function fnColumnToLetter(ByVal ColumnNumber As Integer)
fnColumnToLetter = Replace(Replace(Cells(1, ColumnNumber).Address, "1", ""), "$", "")
End Function

The function was obtained from VBA Column Number to Name-Explained with Excel Examples

Hello, I'm interest in the solution to this problen, could yo send me back the complete code ? Thanks

Miguel P

 

[welshgasman]

Wow!, talk about a blast from the past.

Sorry no, that when I was working at a particular firm. I am now retired.
The best I can suggest is use the links I posted. I can't even remember what that was for either.