VBA Concatenate problem

Hi,

I have a few different worksheets I have been working on for a while, but I am just adding some new functionality in for emailing that I have been working on. My problem is that before it created the output file by copying the data in to a temp worksheet then copy the temp worksheet to a new workbook.

The way I do this now is by creating a new workbook straight away, avoiding the need to create a temp worksheet.

This is probably me just being daft, but I have an odd field on the output that concatenates a few fields.. Below is an example of my original code.

Set wsData = Sheets("OUTPUT LIST")
Set wsCSV = Worksheets.Add(After:=Sheets(Sheets.Count))

With wsData

    wsCSV.Range("A1") = "EMP_ID"
    .Range("EmpRng").Copy wsCSV.Range("A2")
    
    wsCSV.Range("B1") = "ID_UNITS"
    .Range("HrsRng").Copy wsCSV.Range("B2")

    wsCSV.Range("C1") = "ID_RATE"
    .Range("RateRng").Copy wsCSV.Range("C2")

    wsCSV.Range("D1") = "ID_VALUE"
    .Range("ValRng").Copy wsCSV.Range("D2")
 
    wsCSV.Range("E1") = "PAYROLL_ID"
    .Range("CORng").Copy wsCSV.Range("E2")

    wsCSV.Range("F1") = "GEN_CODE"
    .Range("GLRng").Copy wsCSV.Range("F2")

    wsCSV.Range("G1") = "DESCRIPTION"
    .Range("FDRng").Copy wsCSV.Range("G2")
    
    wsCSV.Range("H1") = "ID_DATE"
    .Range("FDRng").Copy wsCSV.Range("H2")
    
    NR = 2
    For cell = 1 To (Range("FDRng").Cells.SpecialCells(xlCellTypeConstants).Count)
        Range("G" & NR) = .Range("FDRng").Cells(cell) & " - " & _
            .Range("TDRng").Cells(cell)
        NR = NR + 1
    Next cell
End With

wsCSV.Move
ActiveSheet.Name = "OVERTIME_CSV"

This is the new code I have but I am not sure how to get the concatenated field in?

    Set Sourcewb = ThisWorkbook
        
        With Sourcewb
            
            Set wsData = .Sheets("OUTPUT")

        End With
    
                    Set Destwb = Application.Workbooks.Add
            

                        With Destwb.Worksheets("Sheet1")

                            .Range("A1") = "EMP_ID"
                            .Range("B1") = "ID_UNITS"
                            .Range("C1") = "ID_RATE"
                            .Range("D1") = "ID_VALUE"
                            .Range("E1") = "PAYROLL_ID"
                            .Range("F1") = "GEN_CODE"
                            .Range("G1") = "DESCRIPTION"
                            .Range("H1") = "ID_DATE"
                            .Range("A2").Name = "Area"

                        End With
                    
                                With wsData
                            
                                    NR = .Cells(.Rows.Count, "A").End(xlUp).Row
                                    .Range("A2:H" & NR).Copy Destination:=Destwb.Worksheets("Sheet1").Range("Area")
                        
                                End With
            

ActiveSheet.Name = "OVERTIME_CSV"

Probably this suffices

Sub snb()
  Thisworkbook.sheets("Output").copy
   Activeworkbook.sheets(1).name="overtime_csv"
   Activeworkbook.saveas .....
end sub

So where's your example worksheet ?

if you want to concatenate 2 columns:

Sub snb()
    Range("FDRng").Offset(, 5) = Evaluate(Replace(Range("FDRng").Address & " & ~_ ~& " & Range("TDRng").Address, "~", Chr(34)))
End Sub

Not sure if this is what you want

Option Explicit

Sub EMAILnSAVE()

    Dim Sourcewb As Object
    Dim Destwb As Object
    Dim cell As Long
    Dim NR As Long
    Dim lCol As Long
    Dim wsData As Worksheet
    Dim SaveStr As String
    Dim tagerror As String
    Dim Email_Send_To, Email_Send_From, Email_Subject, Email_Body As String
    Dim strUserEmail As String
    Dim strFirstClassPassword As String
    Dim errPar As String
    Dim iMsg As Object
    Dim iConfig As Object
    Dim sConfig As Variant
    Dim Deskstr As String
    
        
    strUserEmail = "email@address.ac.uk"
    strFirstClassPassword = ""

        Set iMsg = CreateObject("CDO.Message")
        Set iConfig = CreateObject("CDO.Configuration")
            
            iConfig.Load -1
                Set sConfig = iConfig.Fields
        
                    With sConfig
                        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.0.5" 'Name or IP of remote SMTP server
                        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25  'Server Port
                        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUserEmail
                        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strFirstClassPassword
                        .Update
                    End With
     
                        With Application
                            .ScreenUpdating = False
                            .EnableEvents = False
                        End With
    
    Set Sourcewb = ThisWorkbook
        
        With Sourcewb
            Set wsData = .Sheets("OUTPUT")
        End With
    
                    Set Destwb = Application.Workbooks.Add
                        With Destwb.Worksheets("Sheet1")
                         For lCol = 1 To 8
                            .Cells(1, lCol) = Choose(lCol, "EMP_ID", "ID_UNITS", "ID_RATE", "ID_VALUE", _
                            "PAYROLL_ID", "GEN_CODE", "DESCRIPTION", "ID_DATE")
                            Next lCol
                            
                        End With
                    
                                With wsData
                                    NR = .Cells(.Rows.Count, 1).End(xlUp).Row
                                    .Range(.Cells(2, 1), .Cells(.Rows.Count, 8).End(xlUp)).Copy Destination:=Destwb.Worksheets("Sheet1").Range("a2")
                                End With
            

ActiveSheet.Name = "OVERTIME_CSV"
   
    Deskstr = CreateObject("WScript.Shell").SpecialFolders("Desktop") _
          & Application.PathSeparator & "OVERTIME BACKUP"
    
    If Dir(Deskstr, vbDirectory) = "" Then MkDir Deskstr

SaveStr = Deskstr & Application.PathSeparator & ActiveSheet.Name _
        & " - " _
        & Environ("USERNAME") _
        & " - " _
        & Format(Now, " d-m-yy h.mm AM/PM")
    
 '-----------------------------------------------------------------------------

    Email_Send_To = "email@message.ac.uk"
    Email_Send_From = "email@message.ac.uk"
    Email_Subject = "OVERTIME - OLASS " & Format(Now, "mm/yyyy")
    Email_Body = "SENDERS DETAILS - " & Environ("USERNAME")

'------------------------------------------------------------------------------
           
    
    With Destwb
       .SaveAs Filename:=SaveStr & ".csv", FileFormat:=xlCSVWindows, CreateBackup:=False, local:=True
       .Close SaveChanges:=False
       On Error Resume Next
    
    End With
    
            With iMsg
                
                Set .Configuration = iConfig
            
            End With
    
            iMsg.to = Email_Send_To
            iMsg.From = Email_Send_From
            iMsg.Subject = Email_Subject
            iMsg.Textbody = Email_Body
            iMsg.AddAttachment SaveStr
            iMsg.Send

        On Error GoTo tagerror

    
                If ActiveSheet.Range("a1") = "" Then
                
                    Application.DisplayAlerts = False
                    ActiveSheet.Delete
                    Application.DisplayAlerts = True

                        Sourcewb.Activate
                        Sheets("INPUT").Select
    
                Else
                    
                    Exit Sub
                
                End If

clean_up:
    With Application
       .EnableEvents = True
       .ScreenUpdating = True
    End With
    Exit Sub
    
tagerror:
    MsgBox "Error: (" & Err.Number & ") " & Err.Description & " at " & Err.Source, vbCritical
    Resume clean_up
    
End Sub

That's exactly what the code is doing that I suggested in my last post.

Sub snb()
  Thisworkbook.sheets("Output").copy
   With Activeworkbook
     .saveas .....
     With .sheets(1)
       .name="overtime_csv"
       .cells(1,7).currentregion.resize(,1) = Evaluate(Replace(.cells(1,7).currentregion.resize(,1).Address & " & ~_ ~& " & .cells(1,7).currentregion.resize(,1).offset(,1).Address, "~", Chr(34)))
       .columns(8).delete
     end with
     .Save
   End With
End Sub

You talk about Row G, presumably that's Column G.

If you use With ....End With then drop the sheet.name code into it

                                With ActiveSheet
                                 .Name = "OVERTIME_CSV"
                                  .Cells(1, 7).CurrentRegion.Resize(, 1) = _
                                  Evaluate(Replace(.Cells(1, 7).CurrentRegion.Resize(, 1).Address & " & ~_ ~& " & .Cells(1, 7) _
                                  .CurrentRegion.Resize(, 1).Offset(, 1).Address, "~", Chr(34)))
                                End With

Attach a workbook with what you actually need

Is this what you are aiming for

Dim rRng As Range
Dim LastRw As Long
With ActiveSheet
   .Name = "OVERTIME_CSV"
   LastRw = .UsedRange.Rows.Count
 Set rRng = .Range(.Cells(2, 9), .Cells(LastRw, 9))
 rRng.FormulaR1C1 = "=TEXT(RC[-2],""dd/mm/yy"") &""-"" &TEXT(RC[-1],""dd/mm/yy"")"
 .Cells(1, 9).Value = "DESCRIPTION"
.Columns(9).Value = Columns(9).Value
.Columns("G:H").Delete Shift:=xlToLeft
End With

almost, it is not putting the last rows description in, in column G and it is completely missing column H

It concatenates G & H into I then deletes G & H, leaving the new Column G

So the last result gave the correct text in Column G, but uou want to keep Column H as well?

Untested, maybe

Dim rRng As Range
Dim LastRw As Long
With ActiveSheet
   .Name = "OVERTIME_CSV"
   LastRw = .UsedRange.Rows.Count
 Set rRng = .Range(.Cells(2, 10), .Cells(LastRw, 10))
 rRng.FormulaR1C1 = "=TEXT(RC[-2],""dd/mm/yy"") &""-"" &TEXT(RC[-1],""dd/mm/yy"")"
 Set rRng = .Range(.Cells(2, 9), .Cells(LastRw, 9))
 rRngrRng.FormulaR1C1 = "=TEXT(RC[-2],""dd/mm/yy"") "
 .Cells(1, 9).Value = "DESCRIPTION"
.Columns(9).Value = Columns(9).Value
.Columns(10).Value = Columns(10).Value
.Columns("G:H").Delete Shift:=xlToLeft
End With

If not I'll look later

I've tried introducing the original code but I cant seem to get it to work, the debugger stops on :

        With Sourcewb.wsData

This is the code...

Option Explicit

Sub EMAILnSAVE()

    Dim Sourcewb As Object
    Dim Destwb As Object
    Dim Dsht As Worksheet
    Dim cell As Long
    Dim NR As Long
    Dim lCol As Long
    Dim wsData As Worksheet
    Dim SaveStr As String
    Dim tagerror As String
    Dim Email_Send_To, Email_Send_From, Email_Subject, Email_Body As String
    Dim strUserEmail As String
    Dim strFirstClassPassword As String
    Dim errPar As String
    Dim iMsg As Object
    Dim iConfig As Object
    Dim sConfig As Variant
    Dim Deskstr As String
    Dim rRng As Range
    Dim LastRw As Long
    
        
    strUserEmail = "me@myemail.ac.uk"
    strFirstClassPassword = "password"

        Set iMsg = CreateObject("CDO.Message")
        Set iConfig = CreateObject("CDO.Configuration")
            
            iConfig.Load -1
                Set sConfig = iConfig.Fields
        
                    With sConfig
                        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.0.5" 'Name or IP of remote SMTP server
                        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25  'Server Port
                        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUserEmail
                        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strFirstClassPassword
                        .Update
                    End With
     
                        With Application
                            .ScreenUpdating = False
                            .EnableEvents = False
                        End With
    
    Set Sourcewb = ThisWorkbook
        
        With Sourcewb
            
            Set wsData = .Sheets("OUTPUT")

        End With
    
                    Set Destwb = Application.Workbooks.Add
                        
        ActiveSheet.Name = "EXPENSES_CSV"
                    
                With Destwb
                
                    Set Dsht = .Sheets("EXPENSES_CSV")
                    
                End With
                
    Sourcewb.Activate

        With Sourcewb.wsData

            .Range("EmpRng").Copy Destwb.Dsht.Range("A2")
        
                    NR = 2
                        For cell = 1 To (Range("DescRng").Cells.SpecialCells(xlCellTypeConstants).Count)
                        Destwb.Dsht.Range("B" & NR) = .Range("DescRNG").Cells(cell) & ": " & _
                        .Range("FDRng").Cells(cell) & " - " & .Range("TDRng").Cells(cell)
                    NR = NR + 1
                Next cell

            .Range("UnitRng").Copy Destwb.Dsht.Range("C2")

            .Range("RateRng").Copy Destwb.Dsht.Range("D2")

            .Range("ValRng").Copy Destwb.Dsht.Range("E2")

            .Range("CORng").Copy Destwb.Dsht.Range("F2")

            .Range("GLRng").Copy Destwb.Dsht.Range("G2")

            .Range("FDRng").Copy Destwb.Dsht.Range("H2")
    
        End With
                                           
                                           Destwb.Activate
                                           
                                                        With Destwb.Dsht
                                                            For lCol = 1 To 8
                                                            .Cells(1, lCol) = Choose(lCol, "EMP_ID", "DESCRIPTION", "ID_UNITS", "ID_RATE", "ID_VALUE", _
                                                            "PAYROLL_ID", "GEN_CODE", "ID_DATE")
                                                            Next lCol
                                                        End With
                                                        
    Deskstr = CreateObject("WScript.Shell").SpecialFolders("Desktop") _
          & Application.PathSeparator & "EXPENSES BACKUP"
    
    If Dir(Deskstr, vbDirectory) = "" Then MkDir Deskstr

SaveStr = Deskstr & Application.PathSeparator & ActiveSheet.Name _
        & " - " _
        & Environ("USERNAME") _
        & " - " _
        & Format(Now, " d-m-yy h.mm AM/PM")
    
 '-----------------------------------------------------------------------------

    Email_Send_To = "me@myemail.ac.uk"
    Email_Send_From = "me@myemail.ac.uk"
    Email_Subject = "EXPENSES - OLASS " & Format(Now, "mm/yyyy")
    Email_Body = "SENDERS DETAILS - " & Environ("USERNAME")

'------------------------------------------------------------------------------
           
    
    With Destwb
       .SaveAs Filename:=SaveStr & ".csv", FileFormat:=xlCSVWindows, CreateBackup:=False, local:=True
       .Close SaveChanges:=False
       On Error Resume Next
    
    End With
    
            With iMsg
                
                Set .Configuration = iConfig
            
            End With
    
            iMsg.To = Email_Send_To
            iMsg.From = Email_Send_From
            iMsg.Subject = Email_Subject
            iMsg.Textbody = Email_Body
            iMsg.AddAttachment SaveStr
            iMsg.Send

        On Error GoTo tagerror

    
                If ActiveSheet.Range("a1") = "" Then
                
                    Application.DisplayAlerts = False
                    ActiveSheet.Delete
                    Application.DisplayAlerts = True

                        Sourcewb.Activate
                        Sheets("INPUT").Select
    
                Else
                    
                    Exit Sub
                
                End If

clean_up:
    With Application
       .EnableEvents = True
       .ScreenUpdating = True
    End With
    Exit Sub
    
tagerror:
    MsgBox "Error: (" & Err.Number & ") " & Err.Description & " at " & Err.Source, vbCritical
    Resume clean_up
    
End Sub

Have you set the variables Sourcewb & wsdata?

What you have posted declares the Variables. You need to give them a value using Set wsData=.

If they are fixed you could declare them as a Constant

I think an updated workbook might help.

You don't need those With Statements

  Set sourcewb = ThisWorkbook
  Set wsData = sourcewb.Sheets("OUTPUT")
  Set destwb = Application.Workbooks.Add
  ActiveSheet.Name = "EXPENSES_CSV"
  Set Dsht = Destwb.Sheets("EXPENSES_CSV")

Here is an example for you, it is more or less the same as overtime except there are many more fields on the output tab for data checking.

Current code:

Option Explicit

Sub EMAILnSAVE()

    Dim Sourcewb As Object
    Dim Destwb As Object
    Dim Dsht As Worksheet
    Dim cell As Long
    Dim NR As Long
    Dim lCol As Long
    Dim wsData As Worksheet
    Dim SaveStr As String
    Dim tagerror As String
    Dim Email_Send_To, Email_Send_From, Email_Subject, Email_Body As String
    Dim strUserEmail As String
    Dim strFirstClassPassword As String
    Dim errPar As String
    Dim iMsg As Object
    Dim iConfig As Object
    Dim sConfig As Variant
    Dim Deskstr As String
    Dim rRng As Range
    Dim LastRw As Long
    
        
    strUserEmail = "me@myemail.ac.uk"
    strFirstClassPassword = "password"

        Set iMsg = CreateObject("CDO.Message")
        Set iConfig = CreateObject("CDO.Configuration")
            
            iConfig.Load -1
                Set sConfig = iConfig.Fields
        
                    With sConfig
                        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.0.5" 'Name or IP of remote SMTP server
                        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25  'Server Port
                        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUserEmail
                        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strFirstClassPassword
                        .Update
                    End With
     
                        With Application
                            .ScreenUpdating = False
                            .EnableEvents = False
                        End With
        
  Set Sourcewb = ThisWorkbook
  Set wsData = Sourcewb.Sheets("OUTPUT")
  Set Destwb = Application.Workbooks.Add
  ActiveSheet.Name = "EXPENSES_CSV"
  Set Dsht = Destwb.Sheets("EXPENSES_CSV")
                
    Sourcewb.Activate

        With Sourcewb.wsData

            .Range("EmpRng").Copy Destwb.Dsht.Range("A2")
        
                    NR = 2
                        For cell = 1 To (Range("DescRng").Cells.SpecialCells(xlCellTypeConstants).Count)
                        Destwb.Dsht.Range("B" & NR) = .Range("DescRNG").Cells(cell) & ": " & _
                        .Range("FDRng").Cells(cell) & " - " & .Range("TDRng").Cells(cell)
                    NR = NR + 1
                Next cell

            .Range("UnitRng").Copy Destwb.Dsht.Range("C2")

            .Range("RateRng").Copy Destwb.Dsht.Range("D2")

            .Range("ValRng").Copy Destwb.Dsht.Range("E2")

            .Range("CORng").Copy Destwb.Dsht.Range("F2")

            .Range("GLRng").Copy Destwb.Dsht.Range("G2")

            .Range("FDRng").Copy Destwb.Dsht.Range("H2")
    
        End With
                                           
                                           Destwb.Activate
                                           
                                                        With Destwb.Dsht
                                                            For lCol = 1 To 8
                                                            .Cells(1, lCol) = Choose(lCol, "EMP_ID", "DESCRIPTION", "ID_UNITS", "ID_RATE", "ID_VALUE", _
                                                            "PAYROLL_ID", "GEN_CODE", "ID_DATE")
                                                            Next lCol
                                                        End With
                                                        
    Deskstr = CreateObject("WScript.Shell").SpecialFolders("Desktop") _
          & Application.PathSeparator & "EXPENSES BACKUP"
    
    If Dir(Deskstr, vbDirectory) = "" Then MkDir Deskstr

SaveStr = Deskstr & Application.PathSeparator & ActiveSheet.Name _
        & " - " _
        & Environ("USERNAME") _
        & " - " _
        & Format(Now, " d-m-yy h.mm AM/PM")
    
 '-----------------------------------------------------------------------------

    Email_Send_To = "me@myemail.ac.uk"
    Email_Send_From = "me@myemail.ac.uk"
    Email_Subject = "EXPENSES - OLASS " & Format(Now, "mm/yyyy")
    Email_Body = "SENDERS DETAILS - " & Environ("USERNAME")

'------------------------------------------------------------------------------
           
    
    With Destwb
       .SaveAs Filename:=SaveStr & ".csv", FileFormat:=xlCSVWindows, CreateBackup:=False, local:=True
       .Close SaveChanges:=False
       On Error Resume Next
    
    End With
    
            With iMsg
                
                Set .Configuration = iConfig
            
            End With
    
            iMsg.To = Email_Send_To
            iMsg.From = Email_Send_From
            iMsg.Subject = Email_Subject
            iMsg.Textbody = Email_Body
            iMsg.AddAttachment SaveStr
            iMsg.Send

        On Error GoTo tagerror

    
                If ActiveSheet.Range("a1") = "" Then
                
                    Application.DisplayAlerts = False
                    ActiveSheet.Delete
                    Application.DisplayAlerts = True

                        Sourcewb.Activate
                        Sheets("INPUT").Select
    
                Else
                    
                    Exit Sub
                
                End If

clean_up:
    With Application
       .EnableEvents = True
       .ScreenUpdating = True
    End With
    Exit Sub
    
tagerror:
    MsgBox "Error: (" & Err.Number & ") " & Err.Description & " at " & Err.Source, vbCritical
    Resume clean_up
    
End Sub

I'm sorry but what are you trying to do now, the lst code was concatenating columns

I've cleared a lot of error, see what this produces.

Did you debug the code?

There were several errors that I found, like Sourcewb.wsData, which needed changing to wsData