Joining contents of cells onto other cells

[tipana]

Hey folks
I am as new as new can be to the world of VBA for Excel.

I have managed to (with the help of various helpful people) find and alter code to make the data in my spreadsheet behave the way I want it to.

I am in the local volunteer fire brigade, and have been charged with organising all our contacts so that they are manageable.

So far, I have created a sheet, and called it 'Master'
The master sheet has many rows
Rank | Name | Initials | Surname | Brigade/Organisation | and | Partner Name | P/Init | Partner Surname | Property Name | Address | Suburb | City | Postcode | Phone | Business Phone | Moboile | Email | Join Date | Leave Date | Code

There are also various codes
Current | HLM | D | NBR | Dign | HD | HDLivingPartner
The codes all related to whether the person is in the brigade, a past member, an honorary life member etc

I have a module that will look at the different code types, take the corresponding contacts, and put them on a sheet specifically for that code.

Sub ExtractData()
    Dim lr As Long
    Dim i As Long
    
    mysheet = Array("Current", "HLM", "Past", "HD", "HDLivingPartner", "D", "NBR", "Dign")
    lr = Sheets("Master").Range("U" & Rows.Count).End(xlUp).Row
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    For i = 0 To UBound(mysheet)
        Sheets(mysheet(i)).UsedRange.ClearContents
        With Sheets("Master").Range("A1:U" & lr)
            .AutoFilter Field:=21, Criteria1:=mysheet(i)
            .Copy Destination:=Sheets(mysheet(i)).Range("A1")
            .AutoFilter
       End With
    Next

End Sub

I have to have a series of lists for different types of events.

For some types of events, invitations are sent (via mailmerge) to Current, HLM, HDLivingPartner
For others, invitations are sent to all groups except for D and DH
And for others invitations are sent to other cominations of the contact 'codes'

An example of that is here

Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim ALast As Long, DLast As Long
Dim CopyRng As Range
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
'Delete the sheet "GSInvite" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("GSInvite").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Add a worksheet with the name "GSInvite"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "GSInvite"
'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Sheets(Array("HLM", "Current", "HDLivingPartner", "NBR", "Dign"))
'Messagebox showing the name of the lists that are being exported
    'MsgBox sh.Range("U2")
    'define "ALast" as the last non empty row in the current sheet in the array
    ALast = sh.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    'define "DLast" as the last non empty row in the DestSh
    On Error Resume Next
    DLast = DestSh.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    'Fill in the range that you want to copy
    Set CopyRng = sh.Rows("1:" & ALast)
    'Test if there enough rows in the DestSh to copy all the data
    If CopyRng.Rows.Count > DestSh.Rows.Count - DLast Then
        MsgBox "There are not enough rows in the Destsh"
        GoTo ExitTheSub
    End If
    'This example copies values/formats, if you only want to copy the
    'values or want to copy everything look at the example below this macro
    CopyRng.Copy
    With DestSh.Cells(DLast + 1, "A")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
    End With
    DLast = DestSh.Cells(Rows.Count, "A").End(xlUp).Row
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

I also run a code on startup to create the various sheets

Private Sub Workbook_Open()
Run "ExtractData"
Run "CopyRangeFromMultiWorksheets"

End Sub

as well as a code on each sheet to organise by join date

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
Me.UsedRange.Sort _
Key1:=[S1], Order1:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns
Application.EnableEvents = True
On Error GoTo 0
End Sub

I am currently in the middle of creating yet another sheet that will be a printable contact list for brigade members (current 'code')

I recently have seen the below code which takes first and last name and pops them in one cell

Sub proTest()
Sheets("Sheet1").Select
        Range("C1").Select
        Do Until Selection.Offset(0, -2).Value = ""
                Selection.Value = Selection.Offset(0, -2).Value & " " & Selection.Offset(0, -1)
                Selection.Offset(1, 0).Select
        Loop
        Range("A1").Select
 
End Sub

which could be nice in my situation as I am using the sheets that i create out of multiple sheets (current, hlm, dign ect) as mailing lists.

So the big question here is...

Am I on the right track?
Or have I made an easy task complicated?

I am truly interested in any feedback.

I am sure that someone is going to tell me to try and learn MS Access.... which, to be honest, I would rather not do at this stage... I feel the marco's are simple, and are out there... but I am just not privvy to them as yet

Thanks for reading, and in advance for any advice you can offer.

Tipana

 

[tipana]

Note too, that members are code 'current' then become either 'past' then 'd' or 'hlm' then 'hd' -
This is meant to be a document that can remain in employ over time...