View Single Post
  #54   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default Copy multi-line variable to first empty row

Hi Terry,

Am Mon, 03 Feb 2020 21:37:06 +0000 schrieb Terry Pinnell:

I was just coming back to say that my code was careless anyway: I would
get Tues, Wednes, Thurs, Satur!


the format ddd will bring you Mon, Tue, Wed and so on.
If you want the days like the examples above you must use string
functions and the the whole cell is a string and no more a real date.

In that "ddd dd\/mm\/yy" why is the '\' needed?


The backslash is a marker that the following character is shown in the
format.

Have a try. I did some improvments:

Sub CopyTextToWI_ClausPlus()
Dim strCols As String
Dim strValues As String
Dim strData As String
Dim strRep As String
Dim strTmp As String
Dim varTmp As Variant
Dim varCols As Variant
Dim varValues As Variant
Dim LRow As Long
Dim i As Integer
Dim myDate As Date
Dim objReadFile As Object
Dim FSO As Object

'Modify Path and file name for your device
Const FN = "C:\Users\terry\Dropbox\FinishedWalks\Source.t xt"
Set FSO = CreateObject("Scripting.Filesystemobject")
Set objReadFile = FSO.opentextfile(FN)
strData = objReadFile.readall
objReadFile.Close
strRep = Chr(13) & Chr(10) & Chr(13) & Chr(10)
strData = Replace(strData, strRep, Chr(13) & Chr(10))
MsgBox strData
strCols = "A,B,C,H,I,J,K,L,M,N,O,P,R,S,T"
varCols = Split(strCols, ",")
strValues = "3,4,2,10,8,5,6,7,9,11,12,13,14,15,16,17,18,19 "
varValues = Split(strValues, ",")
varTmp = Split(strData, Chr(13) & Chr(10))
strTmp = Trim(Split(varTmp(4), " = ")(2))
myDate = DateSerial(CInt(Left(strTmp, 4)), CInt(Mid(strTmp, 5, 2)), _
CInt(Right(strTmp, 2)))

With Sheets("Target")
LRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Rows(LRow).ClearFormats
For i = LBound(varCols) To UBound(varCols)
Select Case varCols(i)
Case "J", "K", "L"
.Cells(LRow, varCols(i)) = _
Format(Trim(Split(varTmp(CInt(varValues(i))), " = ")(2)), "hh:mm")
Case "A"
.Cells(LRow, varCols(i)) = _
Format(myDate, "ddd dd\/mm\/yy")
Case Else
.Cells(LRow, varCols(i)) = _
Trim(Split(varTmp(CInt(varValues(i))), "=")(2))
End Select
Next
i = 17
.Hyperlinks.Add _
anchor:=.Cells(LRow, i + 5), _
Address:=Trim(Split(varTmp(i), "=")(2)), _
TextToDisplay:="FW"
.Hyperlinks.Add _
anchor:=.Cells(LRow, i + 4), _
Address:=Trim(Split(varTmp(i + 1), "=")(2)), _
TextToDisplay:="PS"
.Hyperlinks.Add _
anchor:=.Cells(LRow, i + 6), _
Address:=Trim(Split(varTmp(i + 2), "=")(2)), _
TextToDisplay:=Mid(Split(varTmp(i + 2), "=")(2), _
InStrRev(Split(varTmp(i + 2), "=")(2), "\") + 1)

.Range("A" & LRow & ":W" & LRow).HorizontalAlignment = xlCenter
.Range("A" & LRow).HorizontalAlignment = xlLeft
.Range("C" & LRow).HorizontalAlignment = xlLeft
.Range("R" & LRow & ":T" & LRow).HorizontalAlignment = xlLeft

End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016