Help : Join String with Delimiter - need to have the option of downward or rightward

[anish.ms]

Hi,

Thanks for the continued support from all the expert members in VBA Express
This time I would like have an option to choose the route to join strings.

Currently the code is joining values from the right first, I need to have option to choose whether the joinstring shall go downwards or rightwards.

http://www.vbaexpress.com/forum/image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAQ0AAABhCAYAAADMU/SdAAAOBElEQVR4Ae1dbXbjIAzMuXKgnKen6Un2Xw7jfWDGFiAMocgxlvpeX/3BDJoZrDjZrfv49 /fYt/mga0BWwMta2BZluXhBn761YNxc/Tgroyp dZTe41zpvPa9c UVUutyNOaRnALhrSY1zpGgrN17iuM067/ChmMrAF5WtMIrsIQCZNHcs7EJeHpTPrvVivytKYRkoUhI4OW4BxZnzSXdv3S/p7NjzytaQTnYcjIICQ4R9YnzaVdv7S/Z/Mjz4Om8V5 no/l8fxZ3kl1ACeHl X3tTwej 37 RMjM1wyfsOSOTOMm/T9szzJPGmNLZhqbZu4sg/L8ru8aB2v3w3lNtg6ohH33sn1H3mZeJGsjTQvPzoZw62fjbWyZrZxbiMZy869AY40Ha PjSLRkSyjbdha2nO7vpze49qIFnJNRYRLqJ u48dzSS5dD0GebNN4/7jCnsvr9WxvGl74a4kvm7g8TBofjfd X4/lQVzLMWsQ 5BVNDWvjkk5 Av82Id03nSf54zV3nuP5nDsZeJDw1pKENtuun7WE2neeVYbQXgh2NdXit1HHmtK50j3wfO7vMgF DU7uovUvUnth4UWav8BX9nXO1 vFXsfRmKMLN5SKPNmmATleABGE4wBjfwndiurZz 1bOW4/t265gGITckw Jl0oGcYtwkRHFUNKY33wr0ZJk0zmyeognBo2Of2sl5EZYaE3LOII5nfytbGOyY n W9cSYbueHFsALGaGtbHNme04Wp9LLVryUP8HPH1Qql8XY6I0bSPa/cbeY5pGpXiUSAmxX76kzOfw/gQ0VycIY/44s0wzJh0rgxDikvH lNcEMk8R5yE/rabnH7WS pA41qiEGwfcdfWDDjWt9jxejridTj2fMP62OakGx/o95qSF8OdijRKrpZt4Febxv5ZBt5b0rcMrkZuEW21Z7eF65kixl gbs680 aYtXvjbY8P2b2HI4bnmL0yblFwx9b3wvuCO Lc2e 7xelnfaMW IumvpYoZN1ueIU WDM7X32t7GPXLU4TdyxdHykP7tixTvPz/raHfKaRr31gXEPZrr/DphHupP76mQYmZoVzF78Per9YPN4HFB/jFtHHc GDG9y/hUW2GcTVFybxesKHR6m2T2tL8X6KxIcjTui 809OP sbNSHx0J9i1hKFuO1j3vXVdLsYmTXD8hXWCjuWvAAV6 G0EbLjOwcyEJslHWmTSPeBZ38mXpExyFPu7QkTNCYldYTN8qtEhuEMSObKMPmE/n1qS6NxUHZBJnP6KZLaWupgSrvNIU4/6yVV7C E5BWU85piCnep25AkF3 8yrmhs7Wyn1m3WE0cP1dHIPu4YVAcXkDpsejOAXduia9hfPrD15JwujHIc0zTCK/ 9CLkJsakaZHe9ORzCYzJMEwYaWgZBmT4yXAcYVL lSZtdGuHph4ccaKUO//k9PNerrfd6zrNfYzW0u8r 5CwuH4wlsk7qgPjuDBSLDM24to4KuuD8FQbBsa 38l/f1jn2NYcxm01hA2nIbkTcp/dMH3BBeE/iN04CRfyZJuGF5F2KjIpwIQv 7ftrEjSqSLcQZFuHDdXXl/cQTNMuI3DZy1tn4Nw7/Xiz0HS/5eSas7qiIXffo/qzzOLvfTnsYrTvMjai8Z5B8uLnI7N59/XDB2X/h NdK3QsTlnrOlofWw8qVZcd5xmbiw8O/pXHqZpHM3PNQx6LbJNo7aa6WKojaXne3BXxlBt3HZP7RzPrMfa9bsLf7 Iy3pbxzmG1rGt4z7hLCtYz0jMKcEZ60Ce1jSCLzAktulvexKcf6voXHSrfnd7X3p1oxW3jnOY1r Gt4z7hpDVz2xJzSnCmtSNPaxrBGRiSGvWXfQnOv9RzNla7/rP9lp4PeVrTCE7DkJHGS3COrE aS7t aX/P5keevmm4Hfs2D2wN2BqorQHXqOxOI7RrZ9boLwnO0TVK8mnXL ntN7iRpzWN4D4MGRmGBOfI qS5tOuX9vdsfuRpTSM4D0NGBiHBObI aS7t qX9PZsfeVrTCM7DkJFBSHCOrE aS7t aX/P5kee1jSC8zBkZBASnCPrk bSrl/a37P5kSffNPz/t8cvueQPBAH406J7cFfG1PT31F7jnOm8dv0zZdVSK/Jkmkb98WMAt0xEx/Tgroyh2rjtnto5nlmPadc/a26lupEn0zRSiPs/7fHdBsDpyNp D 7KGAm9Nc6ZzvdkN5M bbUiz3rT8L9ZF/8yEcCfmtaDuzKmpr n9hrnTOe1658pq5ZakWelafBP8QG4ZSI6pgd3ZQzVxm331M7xzHpMu/5ZcyvVjTwPm4b/nXvye/0gAxj7rT97cFfG1HT31F7jnOm8dv0zZdVSK/IsNo1Sw3DkALdMRMf04K6Modq47Z7aOZ5Zj2nXP2tupbqRJ9s0jhqGIwS4RF463oO7MqakE8d7a gf2Dj 1679DhlQD8sybBvdIMfcIMvI2BWBK2LLdg7sypqa5p/Ya50znteufKauWWpFn3jQa0AA3DI2G9OCujInEMTs9tTM00x7Srn/a4AqFI09rGsEgGFLwq uwBGdXIV8Cadf/JdvFpkWe1jSCxTBkpOMSnCPrk bSrl/a37P5kac1jeA8DBkZhATnyPqkubTrl/b3bH7k6ZuG27Fv88DWgK2B2hpwjcruNEK7dmaN/pLgHF2jJJ92/ZLefoMbeVrTCO7DkJFhSHCOrE aS7t aX/P5kee1jSC8zBkZBASnCPrk bSrl/a37P5kac1jeA8DBkZhATnyPqkubTrl/b3bH7kaU0jOA9DRgYhwTmyPmku7fql/T2bH3myTcP9Xcj9L6w/sr zCfCnRffgroyp6e pvcY503nt mfKqqVW5Mk0jd/lRf58/eKfF2oP4WkxNR0Dk9PjWva1679bzsiTaRqJVHtyV2JI y5Mbkfca6R2/fdKc//t9mrT4H5Nvncx9OCujKktip7aa5wzndeuf6asWmpFnnzTiP6EQfzWxJED3DIRHdODuzKGauO2e2 rneGY9pl3/rLmV6kaefNOgqPB8jefPezsK8HagcaMHd2VMTXZP7TXOmc5r1z9TVi21Is9601iWxb9FIR OAtwyER3Tg7syhmrjtntq53hmPaZd/6y5lepGnnnTeL X/Z7Cwde/e2J3GiUry8dhcnnEvc9o13 3dJEn0zR lqd7vB/9JncZzgiAPzWlB3dlTE1/T 01zpnOa9c/U1YttSLPvGk0oAFuGBoN6cFdGROJY3Z6amdopj2kXf 0wRUKR57WNIJBMKTgV9dhCc6uQr4E0q7/S7aLTYs8rWkEi2HISMclOEfWJ82lXb 0v2fzI09rGsF5GDIyCAnOkfVJc2nXL 3v2fzI0zcNt2Pf5oGtAVsDtTXgGpXdaYR27cwa/SXBObpGST7t iW9/QY38rSmEdyHISPDkOAcWZ80l3b90v6ezY88rWkE52HIyCAkOEfWJ82lXb 0v2fzI09rGsF5GDIyCAnOkfVJc2nXL 3v2fzI05pGcB6GjAxCgnNkfdJc2vVL 3s2P/K0phGchyEjg5DgHFmfNJd2/dL ns2PPI bRvi1 MfzJ/olNoA/LboHd2VMTX9P7TXOmc5r1z9TVi21Is DpvFefp6P5fV6LdY0WizNx8Dk/IyOI9r13y1l5FlsGv6J5O63W91TvOxOoyt/mNwFvgFIu/4bRBhJQJ6FpuGeoREe82dNIzLukx2Y/AnmTmO1679Tlk4L8mSbhntS1/bQHWsa3dnD5G6CyYHa9U8eX1Y 8sybRtok0n3ScTLWygFMWhkWnb4yJiqU2empnaGZ9pB2/dMGVygceWZNwz8PlD61a9ven0oOcIG7eLgHd2VMUWg40VN7jXOm89r1z5RVS63IM2saGdjuNDJL Wg/A5NbxdxunXf9d87SmEZKVWOASnDMtRO36Z8qqpVbkWW8aDBvAzKnDQz24K2MOxf7hs58a7yzne7 KbRZvGOpGnNY2QPgwZuRgkOEfWJ82lXb 0v2fzI09rGsF5GDIyCAnOkfVJc2nXL 3v2fzI0zcNt2Pf5oGtAVsDtTXgGpXdaYR27cwa/SXBObpGST7t iW9/QY38rSmEdyHISPDkOAcWZ80l3b90v6ezY88rWkE52HIyCAkOEfWJ82lXb 0v2fzI09rGsF5GDIyCAnOkfVJc2nXL 3v2fzI05pGcB6GjAxCgnNkfdJc2vVL 3s2P/K0phGchyEjg5DgHFmfNJd2/dL ns2PPJmmsT6x67H9otpjeeDZGqFKgD8tugd3ZUxNf0/tNc6ZzmvXP1NWLbUiz2LTcA/tKn0BXDpfOt6DuzKmpBPHe2oH9g4/teu/Q4ZUA/K0phFcgSHUpL9uS3D taYz8dr1n n1GXMhT2sawW0YMtJ8Cc6R9Ulzadcv7e/Z/MiTaRruWcLucwz6vT AxxUK8KdF9 CujKnp76m9xjnTee36Z8qqpVbkyTaNmCB8MEo 5AA4Hlff68FdGVNT3FN7jXOm89r1z5RVS63Is6FphDsPaxotvkZjYHJ0UNGOdv13ixp5NjQN9 cMyNPJ7e1J81qAyc2Amw3Urv9mcW4fS RNA3 KkXymsf05g BC72LowV0ZU1sUPbXXOGc6r13/TFm11Io886bRgAa4YWg0pAd3ZUwkjtnpqZ2hmfaQdv3TBlcoHHla0wgGwZCCX12HJTi7CvkSSLv L9kuNi3ytKYRLIYhIx2X4BxZnzSXdv3S/p7Njzx903A79m0e2BqwNVBbA65RPc7uVjafOWAOzO3Af5Cak22eJF1TAAAAAElFTkSuQmCC




Option Explicit


Sub JoinString()
Dim xJoinRange As Range, xDestination As Range, Rng As Range
Dim Delimiter As String, OutputValue As String

On Error Resume Next
'Set xJoinRange = Application.InputBox(prompt:="Select source cells to merge", Type:=8)
Set xJoinRange = Selection
'On Error GoTo 0

'If xJoinRange Is Nothing Then Exit Sub

Set xDestination = Application.InputBox(prompt:="Select destination cell", Type:=8)

Delimiter = Application.InputBox(prompt:="Delimiter", Type:=2)

For Each Rng In xJoinRange
If Len(Trim(Rng.Value)) = 0 Then GoTo NextCell
OutputValue = OutputValue & Rng.Value & Delimiter
NextCell:
Next

xDestination.Value = Left(OutputValue, Len(OutputValue) - Len(Delimiter))
On Error GoTo 0

End Sub

[Paul_Hossler]

Try this

27527

Green = input
Yellow = Left to Right
Orange = Right to Left



Option Explicit


Sub JoinString()
Dim xJoinRange As Range, xDestination As Range, Rng As Range
Dim Delimiter As String, OutputValue As String
Dim bUp As Boolean
Dim n As Long

On Error Resume Next
Set xJoinRange = Application.InputBox(prompt:="Select source cells to merge", Type:=8)
If xJoinRange Is Nothing Then Exit Sub
On Error GoTo 0

On Error Resume Next
Set xDestination = Application.InputBox(prompt:="Select destination cell", Type:=8)
If xDestination Is Nothing Then Exit Sub
On Error GoTo 0

Delimiter = Application.InputBox(prompt:="Delimiter", Type:=2)

bUp = (MsgBox("In Normal Left to Right order?", vbQuestion + vbYesNo, "Up or Down") = vbYes)

If bUp Then
For n = 1 To xJoinRange.Cells.Count
If Len(Trim(xJoinRange.Cells(n).Value)) > 0 Then
OutputValue = OutputValue & xJoinRange.Cells(n).Value & Delimiter
End If
Next

Else
For n = xJoinRange.Cells.Count To 1 Step -1
If Len(Trim(xJoinRange.Cells(n).Value)) > 0 Then
OutputValue = OutputValue & xJoinRange.Cells(n).Value & Delimiter
End If
Next
End If

xDestination.Value = Left(OutputValue, Len(OutputValue) - Len(Delimiter))

End Sub

[anish.ms]

Thanks Paul_Hossler (http://www.vbaexpress.com/forum/member.php?9803-Paul_Hossler)
Sorry for the confusion. Downwards I mean as highlighted in blue below
27529
http://www.vbaexpress.com/forum/image/png;base64,iVBORw0KGgoAAAANSUhEUgAAApMAAACvCAYAAAChMVUCAAAgAElEQVR4Ae2dse7k trXG9Q77Aru1YQMpXHjdukuKBbxIm25hBGldpHGZIN1i4SplgDRpDSyQIsB9gQBbLHALv8N9BV0 cikc6pCgdkiI54vAz8PeMpCH18afDc76hZnamz58/z/gDA8QAYgAxgBhADCAGEAOIgdQYmOd5nqhRL//1ojVXZ067Vm20GMnRofXZ0/HRx9/TtYJWEAABEACBMgS49sFMluHp9MJwnZ0RGzntWrXR5Ofo0Prs6fjo4 /pWkErCIAACIBAGQJc 2Amy/B0emG4zs6IjZx2rdpo8nN0aH32dHz08fd0raAVBEAABECgDAGufTCTZXg6vTBcZ2fERk67Vm00 Tk6tD57Oj76 Hu6VtAKAiAAAiBQhgDXPpjJMjydXhiuszNiI6ddqzaa/BwdWp89HR99/D1dK2gFARAAARAoQ4BrH8xkGZ5OLwzX2RmxkdOuVRtNfo4Orc ejo8 /p6uFbSCAAiAAAiUIcC1D2ayDE nF4br7IzYyGnXqo0mP0eH1mdPx0cff0/XClpBAARAAATKEODaBzNZhqfTC8N1dkZs5LRr1UaTn6ND67On46OPv6drBa0gAAIgAAJlCHDtg5 ksw9PpheE6OyM2ctq1aqPJz9Gh9dnT8dHH39O1glYQAAEQAIEyBLj2wUyW4en0wnCdnREbOe1at dHk5 jQ uzp Ojj7 laQSsIgAAIgEAZAlz7YCbL8HR6YbjOzoiNnHat2mjyc3RoffZ0fPTx93StoBUEQAAEQKAMAa59M JNleDq9MFxnZ8RGTrtWbTT5OTq0Pns6Pvr4e7pW0AoCIAACIFCGANc mMkyPJ1eGK6zM2Ijp12rNpr8HB1anz0dH338PV0raAUBEAABEChDgGsfzGQZnk4vDNfZGbGR065 VG01 jg6tz56Ojz7 nq4VtIIACIAACJQhwLUPZrIMT6cXhuvsjNjIadeqjSY/R4fWZ0/HRx9/T9cKWkEABEAABMoQ4NoHM1mGp9MLw3V2RmzktGvVRpOfo0Prs6fjo4 /p2sFrSAAAiAAAmUIcO2DmSzD0 mF4To7IzZy2rVqo8nP0aH12dPx0cff07WCVhAAARAAgTIEuPbBTJbh6fTCcJ2dERs57Vq10eTn6 ND67On46OPv6VpBKwiAAAiAQBkCXPsm6u7Dpzdd/JHoHrTm6sxtdxcmpH/Uv3mmqYQ/MEAMIAYQA4iBcWKAaj79RyPuwqDdxTBBx/EbDxNRw/5vnOSBQoFrjRhADCAGEANbDCzPYCY7WZm9u5Ed1keagSOxbIkFLMACMYAYQAyMEwPLSGEmYSaLx ADMJJLnOMkT1xrXGjGAGEAMWBuJ29x3X 3rSR/MJBILigtiADGAGEAMjBYD1lL2ZFig9fgzi49mAzM5WgLBeFE0EQOIAcQAYuBuZvLnl/P09psit1yrGyvSOk3z9NWX80 4TW6uGczkTZLqx2me3t1Ei/YNd9JK8 j1NP qvfaRx63O1 874fpIVqnn5hjoIWZ/nebXPcSrdw0 vpvmdx9vHrvMtoc48Pje3kwqNeHd5Zh2zOR38/df2cROHTt/L bvf8lfEfvh7aSYRHFu1ZyJ1zoaSfM1nWRAda3fzN/Sea3On358Mb/68bs DHBl0wszOc3vX/tzZ9t / u1ZE4FQTOJ6/kjzdn6 t1cmuYremO0ygT26/tp1ozao7QanR6fj0oxqaWVUvYpWy7Inl7NrNfSe6p1nmbD1poH5vwotppWc3yaZqPPGmDNoNXiq saBiE aWzFv2B6plc9NbJmzln 4jetVlrFqbc/MnxYHofPeNWZpnKveQE3g2CBe/FyL6TC7ZW/ACC2G6duf8w2kXBnUDBodp3ORMWOTJtsfPy rM8ZMamM51lqG5Z37h5l0zSIVx7yJ6fbDk1dLcnSczmeSQiBxcD9HjyX1xmjVjPGRTtrfUqujw5 q1lOtaUitp0dg6em0x0Yy6bFNSb5JWyzbFCLTUSueS2pLGVjhmo PAMv1I5jchJ5Tkqmq1xlwaMmJ715glc5Yy/ Xcoucl2WoxSMcPa0JgvuXWDqr9VLUSzKRdleN3vWJ1bppezj/wype5BUzb 1XEs1W8smayhlbq8/rq550N4RVtMJOuCTxLGnRsfUdtkzy/M1yTqkiy67tL2 4s0eYmhCO9NbRSn7Iw wlX207RSn0dsX3trSSfcTWaCpvJGmwddiKGnP1i5crfn8L2iCvFcErMSrYpcZGilc5xpDcmDuhc Mj5ofHLb5 hvH2ml19GxGvlgNWUFzWRxrQFtqTnsiG1xrTaua5jJkNarMcsxGOQZyg2hfSe5gvtPNJOLMdxWK 5ftxRxa02g 77hfLYxdzStnJitp/eXL RWZZv68JCUA9bb8869IsgGFmYwzk/47W1mUTAEWt/1k0tLehfLEDiaOiIQQSshVtMrVEi6iCasmNM5UrdTmiG0sV8M3I9mGtLIeeX1LxwGdI2lsNkZCe qvEgYxJGxMp5ozGl6qVufOquGyvsrLXnlb4zOcmEz/bJ89FOvivGlvSy/NKPhfnZg3 Y1OtgTmVmsNCemtxpX5X45/xpjhVK10bc85AXVBj1l7rEM/Qvplzc0SMuDGzbMWtTLKR4tXHT/a2NH9hxhx/Mb iz13yPvva5mayllbTrxyfNNHjmEY2j/4jzORWIGhqhZJGaLKaSc2FiYsqJSzeZyf2lcThTnxXJx/b6Q0kliJabb9yfDJZsp6zx2StxPCAbSxX0kPnLWF4WMu6Cs2rZnzND7SShmi9to UlT4eozS5VbVyLJR6U2H7O R6MQ4cI8HXKrLw7mJWaDnUeyEOSOt6HUuYSY3tRa3SoJnnbIQj O7YVtQq85LJh4kfZ0rWKuLErKCLuIvNBSHjGNoXmutyvMfPlyNxZlKuxvHEp0dhHI1pDNwGbm4m a2kNmNQP6y19mEmYSdek7ZIGJQX7LnyXOP0EEXjHeyVxHCeBTfNOby2tgUTPXGRRPdOco5X6Mww 9trFcUw0v699pbRQHseNinfy401srDgImgc6dYtZztObGgX u1Hjw2xveldg6b/o43q6YM 5D1n5 XjB3cQzu9AdihV9Ljzu2lbjKc/Lz1HmWo5XOdSV3hYxjaF8bMxkyUmKV8oM9/i19c9u79dvcTFbTGvjMJMzk mYEZnIzZsEERwkxZKRkorTH39E3t73kH5u0gklCnuPg S7JVdRK53JWzGzyzzaTmlbB3mcbwzXVOHCheWQc7K7nwXWXWoN6NbYFYpY1xFwLfm2W1tw4oPj0 5uPlN0BCy2HcZ7Jl47F70 rPu4OYCMZO4zi49KaisVZ5l0XGZ j5jq2mVcRJTu4iDcGaEMi5wdcdxIg7tmVrNQPbbcv95x4/fFr2hb9AIz8/uW9rPgspVjC387ireeU M1lL6/62dqxRPhrzM 2HmYwwk8qtUjItnET9pGMmulgFcCfzdu5QQohp65 P qd9rMc/3xWtvjmTJqKGVtJ pFc7n9HmGwmRYLX2Ia412VLfRlNAs6aVda23R 04q8TBr9P8Xv7bh7aocrzV0JodB7bwyjdAPmNN7yPigMZr/jwzfGetRhv/E0wcy0reC7GtErPMkx9tzPJ80bjmzK/smGWNzDCQD3xGMkeusSP6Od63HIk0k2/mZfXR/fBp6J/0MaZQfrvbrBQu7UJmdLk97vbrr26GTdfeuK6vE fkd2cltO4YeKuw6/nlqu0gz2EmN0NHUyuU4MyUswmI45IeKRmZRCQmvJ9UeVWTXs8FV07u4GqE7U aNdlGPg/qraRVjsVwEOMurZXGeMpWjHHHVRyT10uuUml6g1wpQQf6LhEHNF6/SPB11rRyWy6O3K6WVtLpcBWmobRWGkt2HIjbjFKvNJea3kfEwXr9PDN5K62BeSBXajWtTWM2oFX mjNJaa8SszF28ur7GtJh/a xcM5PuiuHIBgljj48FmEnXTKZNxrptqZDJwncnbb6WnrSS9p70Qmu9eQa2ddiCax2uft69tr20D qxMxhsImC2w4hiAmbznpKfVGPnu VrSqDvGnrQSx570Qmu92AXbOmzBtQ7X8jUAZhJGuuAteJjJXiY dJZPpmAKpogBxMCoMQAzCTNZ0Ex /vx5HvUPSXTUJIpxI/YRA4iB0WMAZhJmsqCZHHllkkw0/gMBEAABEACBkQhw7SM7DUNV0FDx5wdHfBxpAvlj5Qnl78c2CIAACIAACDwrAa59MJMwksXeTDzr ZIkZF0 omNfiNSAAAiAAAiDwDAS49sFMwkzCTBaY0TyhCnSFLkAABEAABECgCwJc 2AmYSZhJgtMWZ5QBbpCFyAAAiAAAiDQBQGuffcxk Y3rqc59As5I37 sMcxdxH5lUTyhKrUPboFARAAARAAgdsR4NonzKT93Wn/563M9ov5 1/y/3Hu89 vXn4Scf05H3O l/MPhyuG9XSSgTvVGviJRqMbP6loVjdvF UNBfGEanhKnAoEQAAEQAAEHkqAa58wk9Isnvzm9aHJk 3d56cGze/PGjb6HW19da6sTtVM lo/LcYWq6nLtXpoRD/45DyhHiwDpwcBEAABEACBZgS49iWaSW8V0a7I/fTji3maxGqiuWVN2/tVRNV4FTOTDbSu44wxvs//mmbRe8MT8YS6oTRIAgEQAAEQAIEqBLj2JZjJxRhuK4ZyVc6axrffzB8 7VcLk1Ymkwza/lzLamYbrUnj2q1qPp 5rBKpnXTKE6oTuZAJAiAAAiAAApcJcO2LN5NmxVCsPn56M5sVSWMg38wfzPEX86uvpnnifdZAxZ uuxRyqq5erMTswky202vFe Sypfhu/L8N5OSo77oAnVMdDgHQQAAEQAAEQSCLAtS/eTNpvW7tflHGNozGN0/7LOnFmUq5uxpqoAzNZXavyRZ3V7MaO4zlelxSBT/ZinlBPNiwMBwRAAARAAAQOCXDtizeTgdU Z2XNHv/27TRP3rebdTOZYyTJgB2YyapaT847qInkODiMtgEO8IQaYKgYIgiAAAiAAAgYAlz74s2kNW7hW9 CLGVyO7Q2eczs8YLiM2fQMKBuU88f9uZbXL/traKX zXiy9D7HCuTRNRl5bvGEGpkBxg4CIAACIDAWAa59CWaSPxc5zfJWN30hxzdXZlt u9usFC7tdgZPHJP9 qubYQNzZCYraTVG MyoPrdZDF DbcxjTSF3tDyh3L3YAgEQAAEQAIHnJcC178BMbgZBMxA4DlYcA887XfSR8YTSX4lXgAAIgAAIgM BzEODaBzMZuO3O5giPaUb5OaZG3ih4QuW1RisQAAEQAAEQ6I8A1z6YSZjJiF8aijOV/U2Dcop5QpXrET2BAAiAAAiAwL0JcO2DmYSZhJksMFd5QhXoCl2AAAiAAAiAQBcEuPbBTMJMFjOT FFT4AwPEAGIAMYAYQAyMEwPkemEmYSaLmcku3kZVEkmJE/ BAAiAAAiAwEgEuPbBTMJMwkwWmPk8oQp0hS5AAARAAARAoAsCXPtgJmEmYSYLTFmeUAW6QhcgAA IgAAIg0AUBrn0wkzCTMJMFpixPqAJdoQsQAAEQAAEQ6IIA1777mMmfXy6/rPP2m2Lmptq/E8m/2oOfVHSuVReRX0kkT6hK3aNbEAABEAABELgdAa59wkwuv6/t/KThxD d GL /pe4f2swZODMb28fmsTl5wknc9w lz/FuFs5rKeTtJ9rtcdZnzXA9JOSoXGPtu92Ud5QEE ohqfEqUAABEAABEDgoQS49gkzKQ3RyW9e78ydbBd rhk0x3SZVb9Y81pWp24m6XyutqSxZbBz2Ny8/UMj sEn5wn1YBk4PQiAAAiAAAg0I8C1L9FM8sqhXbG0t3l/ vHFPPFqHRkes2L3cv7h034V8dWP352v4hUzkzW0Ln1uY1jGt22HzXRPhvCK1mbRe8MT8YS6oTRI AgEQAAEQAIEqBLj2JZjJxThtt3SlkbKmUdyq3l6n3zpeDYz9LGK8OVvMnTzX0ldFrfzZzq9ezK/oYwCHt /HM5ZVIrWTTnlCdSIXMkEABEAABEDgMgGuffFm0hg9Wm3cTJJZkWQzZVcUX321N1jqrWBrItfPa0 Z/seXATNbU6q 28vgFl9UcD7bvclR23AFPqI6HAOkgAAIgAAIgkESAa1 8meQVufVLOfZWtzBTxjR6nykkY6WaScd0 beSN/O6N2kHZrKaVv98ckX2TOcYx5Ii8MlezBPqyYaF4YAACIAACIDAIQGuffFmMrDa55g7e/zbt9M8eSuLaWYyxXz65s6atlpayaR6Y9s HzqGYXSuufMm4M1hsI1wgCfUCGPFGEEABEAABECACHDtizeTn85WDOXnJ/cGz7kd7hmQD798OX8v/2kdYwSnOe5zk/tzLWanklaz4ul m9uMzTeY/hgH2R55avGEGpkBxg4CIAACIDAWAa59CWbyzUzGz3zpRNzqpi / IbKbMtvd4t2e5O4GL/185JJX2o5MpO1tPK/M8n//iY9uubybOXu2Y NNYXc0fKEcvdiCwRAAARAAASelwDXvgMziVu2z278aozveaeLPjKeUPor8QoQAAEQAAEQeA4CXP tgJge5BV3DPPp9PsfUyBsFT6i81mgFAiAAAiAAAv0R4NoHMwkzef6PyCfw6W8alFPME6pcj gJBEAABEAABO5NgGsfzGSCWfJX4rDtfhzi3iFfVx1PqLpnQe8gAAIgAAIgcB8CXPtgJmEmi61MU lCN jf/zzTjDwwQA4gBxABiYLgYmOcZZhJmspiZvM97pQcogZmEmUYMIAYQA4iBEWMAZtK9TYvb1td4PMD C3eeUIyYQjBmFEzGAGEAMIAZgJq ZJ5hPl999nN0DlCChIqEiBhADiAHEwIgxADPpmiGYw2s8HmDh7nPKERMIxozCiRhADCAGEAN3NJ P0O970qzq3Nnb8iz5vv7m3zsafB72Ps3uAkjsl1L9N8/S78Ifg39EvTH0xzb/eSe8zaPnnNL8mtgfc7/iB/I /m Z3fwvHyW30MtdeYpbmXmdxcJtrfZYHLNfXf7p5vPIYOA56itsrucs1k8vvazs/a0iTwvxd 8lAMohThPFafoZxmqfT37qup5MM7LlWPvfL Qd LX5OcTXUD7Bw9zmlTSLvv A5s398/89riZCKv2ZW1vN7SezXPy16SAM/14zE2teaB7YxXRmLNo7QeT9ykj54DLXhXHZFKxXaWL2k0bx2mmbtnLX0alrZOHAMxLyxeJRWZmm uvS3Oj4rZmDgwb9RsQTbPp2l VNyexgEbdH9eezmDY4UfHxUHzJLnMz3ekqvNTfINO80zzQDX4hoTs/Sa9fzK9ec4CD66ZlKuBp785nXGate5QbPnNat9L cffn6pmMl6OlUzSdrkb45bQ7n/vXGpcZzn93F2D1ASMDmUVLTiF5yYgb7odacFwh6n8xmjIBODLR7S4Oxec3BO1ldyLNo4KLld4VZ Sq8rdmhxZ3Gh8WgFhrvRYUq/G1pzXxsNH0i7jRImB1lqJi4zZqLGJMZTkSmNPOn9gzhn2Qp /XVJvklZrKG4ds8zNck3JDy25pnKvGQMxMUt6gzWDecc ppvJxWSu7xDsCuKyoris1pnb06vp4pW8bUXjyHiR4TTHipnJCloD2szYT1dSYSYfYO3anzIw6c6 SGB1b55Et6LxatBoTYVTWd4 23Vni3xlF0c avEL7AmPg1x NJTQOanM0ltfeym1oHDXNZEjvkVa6Dir3gCHb8T/hSqxS2F7SanVQATHcA9r5eh89pmi9Ggd0LhkfdC3k9pFG3n klY7TsVrzz5y/oJmsrjUxFzC/kKGrrrWgmQxppbEdzbGY3EV9yjdAJhaU S9fQ 1DXJl5rZhNzVlSs3meZiYXY7h9nnHZXsyhNY3mVvZ VVNdmZQmTT5XV0H351o a1lJK2nzViZhJjez3N7B3eiMgYRxlBh8sySLpDEv4laZTCyx73r9xOBvm8lvk/JqXAP6ZcIIjeVsHNT2aCzaOEw7UexTk3NIK uRPOk8bE6OtFK7U72BQhzkfcI3pJf0FNdKGqSBlM9P9D0qDoxWigO6TvSY JmuENdqcSD52bnFsSX5nT0P6a0WB0LvaXyL10ntj9LKMRGbt0hzqlZqc5QPTllxTrU5wRi/Qiv/teMgNWfJWDDPk8wk34YWBs8YKf4spDn Yn711f7zkedm0jN JcxkZa3ruwMueFiZNJ bvJG1ay8lkHRDSWzmhCNebyYyF0ouRLSCx/vsa08Tmd fSGLBRBHQsUsQos/dWALtnXFQ24OxxI6D9Jg T96thzTvtAotsgg5eg 0Uv aXlN4OBfwo Af0ij37fRqbC9qXU1qCTOpaRXszcqOiGmNKzFy2Iq2kt/R8x1XoaVGHHC8r/UhIQZoDDu9GtsLcbAys31cfsPWQqtldNmka1pFnCTFrO1X5m1pSlfm1P/B3y4GhJYqMWt1BGvEgcag9iQzaVblxK0BTppsJkkHJmJh1DSka1hJmspHVZ9dxW4mh7p1 Y7dDrn3lfewd3ozMGJl4wMch3rTyH6FEUSlNkA7dLYoovTXQ/MfjbJhkEEmowSdhx7cYSMQ7qLzSW2HGwntTX77TSGCL0hrSuYxDXh3UdPTomNRAXfrud3kpad7r oPFcNT4TWlaEX09p19bkUKcwRekvFAelPMT7 eFvErHYN/Fjl7UdoTb3 V7RmxWwop9p4k0aQdYUed1wb5a5gjYjIXesYksxkYLXPMUb2 Lf0zW1vpe7MTJpjsqiuz2O QX5wm7uSVme81jSS/qPPgYZe/8z7bmTt2ksJTLxgYgglHNnWHn9H39z2Cn1s4t8lhkBC271Gagg8341FGwf1cTCW2HFwokp9/U6r0HKY1A 0kobU89PrL5kIjW2mVjOONb 6CwOxK1M7tppWwd6P6VOuFLNe/LO5OryGXtzutAoth31ksuVYlY n4/O0UrudXo1tAa27cwZ0yTHx8127ylpzjWQWVxEnSTFrr6EzlwK5lxmGHndchZaaMZtaD3bak8zkp 8W4hY2T/Pzk3uAlrd6VWJlspNWMy/sM5TObRW1s7R3cjc4YSMLBxKDcqqGkyUbEb28mfMQKWSgxUF/cLyUCeZ6Yfn0t1Iffp59g5Dlk 5jzrX1xwRT/HqLWXp5r7UfRe6SV2mvnk cwrxX/dElM25DeM7altBpzJgxbDa3E5kjv6flsEZaF2bw QW IK mpwvaf0/xexCi/keI5dzpWmztCeqtotefzeXIc302rMeXiurNOeqyhlfrNiln WIbI0f4bCk1vKAZIT804WDkeMKbj6l amXwzfzArfu47WvpCjjFVYjVyZ7JEu7AZFbeOi5jJSlrFOJbPxYhvsA98e5tN5o2sXXspgQl3lB i40KyfrbKfCfSTu9kWxkS24yIlJ7lJXP7KEycIW5zXc54kPNknPw OxRq9tU/x2cbTsYh2u3GIY9yv/xo/QbNGfgxqpesT6Js P3iq1Wvnawn1KVcQNK2kOai3hlY/Rr3Vv9JaaWynbMUYd1x5RdiLZ2kuNb1Brt715Bi7HAf2OnJ/5rHiHDvl6o0xxJbjLnRM48pt18/eclyJ68kcLnMN9Gn6tnmttNarMbvLB5x/LSNNb uYNXq8Oba7I8DX9 zx2EwKcweTtP6j3Gya8BiOj/YO7kZnPJtoNz9GCUwWaUqod/7rSS 01oslsK3DFlzrcGUT3lOuja4DMJNhUwSzmMflRtauvZSbG7CjpEArHKHViaPXP3p/T3qhtV5RBts6bMG1DlfKmz2xTc7zMJN5pglmM8ytvYO70Rk7NZPJSQPjvPWqLa5nPTMAtmCLGDi IAZjJsCmCWczjciNr114KTBZMFmIAMYAYQAyMGAMwk3mmCWYzzO3z58/zqH94x3rwjnXExIoxw1AgBhADI8UAzGTYFMEs5nFpvxx4nzOSicZ/IAACIAACIDASAa59Ew0a5inPPIGby22kCeSPlSeUvx/bIAACIAACIPCsBLj2wUzinz4q9mbiWSdLzLh4QsW8Fq8BARAAARAAgWcgwLUPZhJmEmaywIzmCV WgK3QBAiAAAiAAAl0Q4NoHMwkzCTNZYMryhCrQFboAARAAARAAgS4IcO2Dmcw1k/Szj2 /CRix5bfJJ/HzkqN8trKLyK8kkidUpe7RLQiAAAiAAAjcjgDXPmEmv5u//8r93W3 fc1pejF//4v7ZYsUg/TD2 nAeFGfofOe/eZ16PWs 5pOGtO5Vk vZxiX3yRfNCzPp5l uzyFVc vvV2UNxTEE6rhKXEqEAABEAABEHgoAa59wkxK07OsrpUyQucGbTGHeecqqzPGTNJYSKsxi9JM/vLl/Moz3bvX5K6CdtLuoRH94JPzhHqwDJweBEAABEAABJoR4NqXaCbtLdzJrgRaM7WswonVRLoFPNH2 fhXx1Y/feSt1tcxkDa2b4d4ZxXXM22s hPZ1YgxzVkibRe8NT8QT6obSIAkEQAAEQAAEqhDg2pdgJn3Tt2wv5tCaRvMZwv1qYczKZN4t9f2 5FhNUS tmFH0z6W8bHWa1UpjsJzaSNN6R/ MJNTIDjB0EQAAEQGAsAlz74s1kwBgZA8VfQrG3eV/R5y55nzVP52ZyM2hkSEyfU xnDQ/MZAOtvnn0t2Emx5xQY40aowUBEAABEBiZQLqZNLds Ysu4lEYR2Mavc8NkqlKMZNprz8wkw20 ubR34aZHGt68YQaa9QYLQiAAAiAwMgEuPZdWpk0holv3drVwG/pm9vyiymPMJOBlcnSWnfmMfD5yN1rmNWTPmJCjUwAYwcBEAABEBiNQLqZ/LSsAu6/QEO3qeXnJ/erhcZUiRVMx9j5xsoYwYu3uRto3RtFn49k4t7KPx2/z6Oj7dEmkRwvTyi5D89BAARAAARA4JkJcO2LX5kkUxpyenkAAA9bSURBVGON3vZlmfA/k2OMlvk2tzVRot3OjIpj3O/uNYeGam9cV6MW6Df0T/okaeVVVv42Oz/ySqx/ez3WQB Ory8T swTRhsbTyjtdTgOAiAAAiAAAs9CgGvfgZnsy8SsBvJJTFmv43mWyZEzDp5QOW3RBgRAAARAAAR6 JMC1D2YSBtT7dz/z30j0OBFKaeYJVao/9AMCIAACIAACdyfAtQ9mEmYSZrLAbOUJVaArdAECIAACIAACXRDg2gczCTMJM1lgyvKEKtAVugA BEAABEACBLghw7Zv4SReqOxHZkmnOuXLaaOipT/yBAWIAMYAYQAwgBsaKAfIHXZlJCtAe/svVmdOuVRuNe44Orc ejo8 /p6uFbSCAAiAAAiUIcC1D2ayDE nF4br7IzYyGnXqo0mP0eH1mdPx0cff0/XClpBAARAAATKEODaBzNZhqfTC8N1dkZs5LRr1UaTn6ND67On46OPv6drBa0gAAIgAAJlCHDtg5 ksw9PpheE6OyM2ctq1aqPJz9Gh9dnT8dHH39O1glYQAAEQAIEyBLj2wUyW4en0wnCdnREbOe1at dHk5 jQ uzp Ojj7 laQSsIgAAIgEAZAlz7YCbL8HR6YbjOzoiNnHat2mjyc3RoffZ0fPTx93StoBUEQAAEQKAMAa59M JNleDq9MFxnZ8RGTrtWbTT5OTq0Pns6Pvr4e7pW0AoCIAACIFCGANc mMkyPJ1eGK6zM2Ijp12rNpr8HB1anz0dH338PV0raAUBEAABEChDgGsfzGQZnk4vDNfZGbGR065 VG01 jg6tz56Ojz7 nq4VtIIACIAACJQhwLUPZrIMT6cXhuvsjNjIadeqjSY/R4fWZ0/HRx9/T9cKWkEABEAABMoQ4NoHM1mGp9MLw3V2RmzktGvVRpOfo0Prs6fjo4 /p2sFrSAAAiAAAmUIcO2DmSzD0 mF4To7IzZy2rVqo8nP0aH12dPx0cff07WCVhAAARAAgTIEuPbBTJbh6fTCcJ2dERs57Vq10eTn6 ND67On46OPv6VpBKwiAAAiAQBkCXPtgJsvwdHphuM7OiI2cdq3aaPJzdGh99nR89PH3dK2gFQRA AARAoAwBrn0wk2V4Or0wXGdnxEZOu1ZtNPk5OrQ ezovh7ulbQCgIgAAIgUIYA1z6YyTI8nV4YrrMzYiOnXas2mvwcHVqfPR0fffw9XStoBQEQAAEQK EOAax/MZBmeTi8M19kZsZHTrlUbTX6ODq3Pno6PPv6erhW0ggAIgAAIlCHAtQ9msgxPpxeG6 yM2Mhp16qNJj9Hh9ZnT8dHH39P1wpaQQAEQAAEyhDg2mfMJG3gDwwQA/kx8J///b8Zf2CAGEAMIAYQA6PFANlSrEyWMedOL zUnZ0RGzntWrXR5Ofo0Prs6fhoyQPjRcFEDCAGEAOIAYoB g9msoJjyTVWOe1atdEw5ejQ uzpOJIqkipiADGAGEAMjBgDVKthJis4llxjldOuVRsNU44Orc ejo YQDBmFE7EAGIAMYAYoFoNM1nBseQaq5x2rdpomHJ0aH32dBwJFQkVMYAYQAwgBkaMAarVMJMVHE uuscpp16qNhilHh9ZnT8dvlUD /od5 v2/7v FINI5TfMXf/5vN1q74Cq DPbX30/zb/ OAl90ftq4nX7zl/kfgnXRc4zY77//Mn8xTXMXXFlrD3mWYum0Jvxr/u1F7lSrYSYrOJZcY5XTrlUbDVOODq3Pno4vheS/8x9/MxmDRCbJ/ft6/uO/rxV1MgbnZkacP6rQidcX1nuu1SYv55x/mP96WkAfrNUUDdb9OK0UZ dstxj7x5 /XmJQjYVHsQ2d93Fsda5u0SW 52 EQuPjvFA5H7DZcebYmVF7oFaO6clee2vWz98E1dN7Hgd83kWree2kXUtuw9dePmptt/kcerNyrpXainMH8sCSIxYNnC/OuYf1UK2GmazgWHKNVU67Vm00TDk6tD57Or6f6EvhyZmY 76WCawlDjpO5zNJIZA4jvpd9pfVq2l1tNjCF8/q0VpTCkBZrcQtiq1h of5r1SYk2KhrN5zrUuhi7/ufiFrqTWSEborJao Ng1bOwPje/zLe1VjqfO6fO44Z18mNZvafnNkbXfcNDr4/jSnobarW54rAmmBzhcs rHfg2dzWvkmusctq1aqPBytGh9dnTccccmQR ljSWY vKpS32yztDkajWxCXeXdqVhrPklZcQjvTW1Wq4FTOTYa10jjDbr cvvJXkM66bVjcB7689FzmteIT1hrVSXMTHwVrgipnJGlprmcmw1mtxQH2mXHcZA4 LgzU211zi6wptL/zCJj/M9lrMLn1ucy/F J6xraA1MJ/S8u0R27DWazG7XdugxlBMhPatb0i2/ta4sseoVmNlsoJjyTVWOe1atdEw5ejQ uzpuD 5jt B gVUJs7l XIre590Tt8xiwkfTBzi F7rUUKur9VoSU5gezZ8O2crgJIrje YbSzX/1jTuxW94 S6MQ5p3fSE9R5rpX5VvbLgyedqDLSOAzvO9VZsqlkLsV36DHPduIfm2ClXudLLeous J7pvRgH4nqfjk28bonbENeNXZjtRa0mB9Bt K Xz00mfRYxpLcS10CuSsu3qVo37skxK65rSGNo35LjxIKG6GPLaaTJ/aNaDTNZwbHkGqucdq3aaJhydGh99nTcn1yHZpKLkpiMZlJz8jTH7YoZ77OvjS0IwSQhzrfXSokh kOQaaOXzXjZomlYa/wFblatpJz7nVMJEaHoPtNK1O9frFdESZrKaVrcgmbidUr4wlBGzuXHAMbDOSWme3HFEz69Vi1u8 S cDjvv4z2wHuFbXanmyUV85Z7KtFrOeTtYbnRMCbDWtK/t9XTjPBRu7UE0I7YOZvJnryDVWOe1atdEQ5 jQ uzp L6ABJIGJQV B85JiB9F8jQJInBL7Uri2OvbEs1yLKC3utbUgsya87TSOENsY7lKTvHmN6C1Yhw4RoTPE13oiG9 Ab/U44OuqGeXtdfJabCtlcfMrKw4CBX Zy64RXHT5Og 48vXhHCAfC aDtPh hFY/5lLzgt8 Lg5CuWCNDcH/ Jou13k35 i6Hv7laV11eXUh9tqGjGNoH8zkzVxHrrHKadeqjYY4R4fWZ0/H98kjkDQowYSKkkw89vhv6Zvbngm4kjj2 vyEF9BbVWtqwZB6M7QK9j7bWK7MMO31Aa1Cy E32DPjwGiTpmR9HnsLOaC3ahzI61rATGpaBfu0OCAuHkNjsi aSU1vZhxwrAbfHMh8E3weiAHBrXTMGlPu5brLRr061y1uac5denOpaRXs02J20xg0joH4Db4uGC Nb3xRr9B9uc1dwLLnGKqddqzYaphwdWp89Hd SN0 yg4RsV37CyWcxWMuxfXsz0SPeMYcSgt52fz4uRDW0GtPjFxCbtMprpWtyzPb0fP/ y/xH e80msTvFo/T9qGVPjPOhXcNtk4sUsEQnM 1Eqe2ceBotWx5pbG81gtx4Hzmdpnj/puKc70hrhvvWnFgNInrz7xvpdWYGteoS93nWjeGHDfLGNvML6ON/0kj/qLfaY4OxcGZ1isxu8Qp8ZA8OQZ4rm xJ3Pk1nZ7/fE qtUwkxUcS66xymnXqo2GKUeH1mdPx/cTLpQ07GS0RXP9Nrf9nJg/4f1EtaxqLp/d2xLANsGDq1K2kPiFL1pvDa2BPg2LSlpprKdshZ491 U6ymvl/1uf52zbx4FzbT0zea6VYulAr2DELKh4n3JdV1QOYjbQp RfWuu1OOC7CsefnT3Xe8DVY1SMrfKG5W5ajZ51FZ0Yb byXOujY9ZdmS6t9WrM7rl6d7yMkRcxfWqEt1rj5BisTNazKrnGKqddqzYarRwdWp89Hfcn1722q ZBtyfle2vwE1ZNWLmRgWz6mEAflmfJc64kttNaLA46H649Uq7EyWcGx5BqrnHat2miYcnRoffZ0/M4TnlaP5IoPtF5PnswQbMuxZKb02BPX3vT2xBZa68wvOddKPKdaDTNZwbHkGqucdq3aaJhydGh9 9nS8xIREH30kTlwnXCfEAGIAMbDFANVqmMkKjiXXWOW0a9VGw5SjQ uzp NILFtiAQuwQAwgBhAD48QA1WpjJskI4A8MEAP5MYDEOU7ixLXGtUYMIAYQA1sMrGaylxWgXla/cnXmtGvVRouRHB1anz0dH338PV0raAUBEAABEChDgGsfbnOX4en0wnCdnREbOe1atdHk5 jQ uzp Ojj7 laQSsIgAAIgEAZAlz7YCbL8HR6YbjOzoiNnHat2mjyc3RoffZ0fPTx93StoBUEQAAEQKAMAa59M JNleDq9MFxnZ8RGTrtWbTT5OTq0Pns6Pvr4e7pW0AoCIAACIFCGANc mMkyPJ1eGK6zM2Ijp12rNpr8HB1anz0dH338PV0raAUBEAABEChDgGsfzGQZnk4vDNfZGbGR065 VG01 jg6tz56Ojz7 nq4VtIIACIAACJQhwLUPZrIMT6cXhuvsjNjIadeqjSY/R4fWZ0/HRx9/T9cKWkEABEAABMoQ4NoHM1mGp9MLw3V2RmzktGvVRpOfo0Prs6fjo4 /p2sFrSAAAiAAAmUIcO2DmSzD0 mF4To7IzZy2rVqo8nP0aH12dPx0cff07WCVhAAARAAgTIEuPbBTJbh6fTCcJ2dERs57Vq10eTn6 ND67On46OPv6VpBKwiAAAiAQBkCXPtgJsvwdHphuM7OiI2cdq3aaPJzdGh99nR89PH3dK2gFQRA AARAoAwBrn0wk2V4Or0wXGdnxEZOu1ZtNPk5OrQ ezovh7ulbQCgIgAAIgUIYA1z6YyTI8nV4YrrMzYiOnXas2mvwcHVqfPR0fffw9XStoBQEQAAEQK EOAax/MZBmeTi8M19kZsZHTrlUbTX6ODq3Pno6PPv6erhW0ggAIgAAIlCHAtQ9msgxPpxeG6 yM2Mhp16qNJj9Hh9ZnT8dHH39P1wpaQQAEQAAEyhDg2gczWYan0wvDdXZGbOS0a9VGk5 jQ uzp Ojj7 nawWtIAACIAACZQhw7YOZLMPT6YXhOjsjNnLatWqjyc/RofXZ0/HRx9/TtYJWEAABEACBMgS49sFMluHp9MJwnZ0RGzntWrXR5Ofo0Prs6fjo4 /pWkErCIAACIBAGQJc 4yZpA38gQFiADGAGEAMIAYQA4gBxEBKDJAtncp4U/QCAiAAAiAAAiAAAiAwIoH/B66krcIifp8KAAAAAElFTkSuQmCC

[anish.ms]

Thankyou very much Paul_Hossler (http://www.vbaexpress.com/forum/member.php?9803-Paul_Hossler)

I have made few changes in the code as given below


bUp = (MsgBox("Each cell value in new line with numbering ?", vbQuestion + vbYesNo, "Up or Down") = vbYes)

If bUp Then
For n = 1 To xJoinRange.Cells.Count
If Len(Trim(xJoinRange.Cells(n).Value)) > 0 Then
OutputValue = OutputValue & "(" & n & ") " & xJoinRange.Cells(n).Value & Delimiter & Chr(10)
End If
Next

Else
Delimiter = Application.InputBox(prompt:="Delimiter", Type:=2)
For n = 1 To xJoinRange.Cells.Count
If Len(Trim(xJoinRange.Cells(n).Value)) > 0 Then
OutputValue = OutputValue & xJoinRange.Cells(n).Value & Delimiter
End If
Next
End If

xDestination.Value = Left(OutputValue, Len(OutputValue) - Len(Delimiter))

[Paul_Hossler]

That's OK, but I suggest the following to ensure that you're going in the right direction




Option Explicit


Sub JoinString()
Dim xJoinRange As Range, xDestination As Range, Rng As Range
Dim Delimiter As String, OutputValue As String
Dim bRows As Boolean
Dim r As Long, c As Long

On Error Resume Next
Set xJoinRange = Application.InputBox(prompt:="Select source cells to merge", Type:=8)
If xJoinRange Is Nothing Then Exit Sub
On Error GoTo 0

On Error Resume Next
Set xDestination = Application.InputBox(prompt:="Select destination cell", Type:=8)
If xDestination Is Nothing Then Exit Sub
On Error GoTo 0

Delimiter = Application.InputBox(prompt:="Delimiter", Type:=2)

bRows = (MsgBox("[Yes] = Across Rows, [No] = Down Columns", vbQuestion + vbYesNo, "Up or Down") = vbYes)

If bRows Then
For r = 1 To xJoinRange.Rows.Count
For c = 1 To xJoinRange.Columns.Count
If Len(Trim(xJoinRange.Cells(r, c).Value)) > 0 Then
OutputValue = OutputValue & xJoinRange.Cells(r, c).Value & Delimiter
End If
Next c
Next r

Else
For c = 1 To xJoinRange.Columns.Count
For r = 1 To xJoinRange.Rows.Count
If Len(Trim(xJoinRange.Cells(r, c).Value)) > 0 Then
OutputValue = OutputValue & xJoinRange.Cells(r, c).Value & Delimiter
End If
Next r
Next c
End If

xDestination.Value = Left(OutputValue, Len(OutputValue) - Len(Delimiter))

End Sub


27533

[anish.ms]

THANKS A TON Paul_Hossler (http://www.vbaexpress.com/forum/member.php?9803-Paul_Hossler)

[p45cal]

If you've got a version of Excel with TEXTJOIN available as a worksheet function then the likes of:
=TEXTJOIN(",",TRUE,C4:E15)
or the other way:
=TEXTJOIN(",",TRUE,TRANSPOSE(C4:E15))
might do it for you.

[Paul_Hossler]

p45cal

:thumb:thumb:thumb - you can take the rest of the day off

anish.ms

If you need some VBA to include as part of a larger project, this is how I'd merge p45cal's into the earlier one






Option Explicit


Sub JoinString()
Dim xJoinRange As Range, xDestination As Range
Dim Delimiter As String
Dim bRows As Boolean

On Error Resume Next
Set xJoinRange = Application.InputBox(prompt:="Select source cells to merge", Type:=8)
If xJoinRange Is Nothing Then Exit Sub
On Error GoTo 0

On Error Resume Next
Set xDestination = Application.InputBox(prompt:="Select destination cell", Type:=8)
If xDestination Is Nothing Then Exit Sub
On Error GoTo 0

Delimiter = Application.InputBox(prompt:="Delimiter", Type:=2)

bRows = (MsgBox("[Yes] = Across Rows, [No] = Down Columns", vbQuestion + vbYesNo, "Up or Down") = vbYes)

With Application.WorksheetFunction
If bRows Then
xDestination.Value = .TextJoin(Delimiter, True, xJoinRange)
Else
xDestination.Value = .TextJoin(Delimiter, True, .Transpose(xJoinRange))
End If
End With

End Sub

[anish.ms]

Thanks p45cal (http://www.vbaexpress.com/forum/member.php?3494-p45cal) for your response
Yes, i'm aware of the Textjoin function
But some times when I convert pdf to excel with 100's of line items, macro will be more helpful to join the texts and it is nice to have in the personal.xlsb

[anish.ms]

:thumb
Can you look at the following scenario
If delimiter is left blank and click cancel instead of ok button in input box, False is appearing in b/w the cell values

[anish.ms]

Hi Paul_Hossler (http://www.vbaexpress.com/forum/member.php?9803-Paul_Hossler)
I was trying to do it with the help of user form with more options based on my limited understating from your text to case user forms, but could not succeed :(

[snb]

Sub M_snb()
sn = Range("A1:B8")

For j = 1 To UBound(sn, 2)
c00 = c00 & " " & Join(Application.Index(Application.Transpose(sn), j))
Next

MsgBox c00
End Sub

NB. Avoid 'Worksheetfunction', in several cases it contains bugs. 'Application' suffices.

[Paul_Hossler]

Play with this

I added Source range and Destination cell to the user form along with the delimitator

Note that the RefEdit control and not Textbox is used to enter the 2 ranges

I simplified the operation selection by removing the eNum and passing paramters to the JoinString sub

27535

[anish.ms]

Superb :clap:Thanks a lot Paul_Hossler :bow:
Let me learn from your codes :think:

It is working perfectly in this workbook. But if I export both the form and module to my PERSONAL.XLSB, I'm getting error at Call JoinString

[Paul_Hossler]

Works OK here

What kind of error?

27545

[anish.ms]

Yes, it is working fine now. It seems if i change the module name to JoinString then it is not working :think:

[snb]

if i change the module name to JoinString

:devil2:

[Paul_Hossler]

Yes, it is working fine now. It seems if i change the module name to JoinString then it is not working :think:

That's because the sub is also called 'JoinString' and Excel gets confused with what are essentially 2 variables called the same

Call the module 'mod_JoinString' instead

[anish.ms]

:thumb