Copy multiple content from one cell to another without overwriting

[Subhra Sankha Sardar]

​​I must find all the steps containing <code style="margin: 0px; padding: 1px 5px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; background-color: rgb(238, 238, 238); font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: pre-wrap; background-position: initial initial; background-repeat: initial initial;">"CD /"</code> and <code style="margin: 0px; padding: 1px 5px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; background-color: rgb(238, 238, 238); font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: pre-wrap; background-position: initial initial; background-repeat: initial initial;">LCD</code> from each cell of an workbook and paste it to corresponding cells without overwriting.
Here is a sample input :

<code style="margin: 0px; padding: 0px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit;"> //STEP002 EXEC PGM=FTP
//SYSOUT DD SYSOUT=*
//SYSIN DD *
NOLOG *****Dummy Member Include*****************************************
NOLOG *****Dummy Member Include*****************************************
LSITE CC OFF PHG00280
LSITE TRCC ON PHG00290
LCD POWER.LST.X
CDIR/REPORT/CURRENT2
NOLOG *****Dummy Member Include*****************************************
PUT %FILE12,ESDS,F,2000,2000 Industry.txt
PUT %FILE13,ESDS,F,2000,2000 SuperBank.txt
PUT %FILE14,ESDS,F,2000,2000 Executive.txt
CD /UPLOAD
LCD SAMPLE.TXT
LCD POWER.LST.X2
MPUT PHGDFM01.*
</code>
I created this sub:
<code style="margin: 0px; padding: 0px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit;">Sub Search2()
Dim MatchString As String
Dim matchstrin2 As String
Dim counter As Variant
Dim Name As StringDim
Datain As String
MatchString = "CD "
MatchString2 = "CD "
For counter = 1 To Range("A:A").Count
Datain = Range("A" & counter).Value
If (InStr(1, Datain, MatchString) > 0 Or InStr(1, Datain, MatchString2) > 0) Then
Data = Split(Datain, vbLf)
cnt = UBound(Data)
For I = 0 To cnt
If Data(I) Like "*CD /*" Then 'Temp = Split(Data(i), " ") 'Temp2 = (Data(i) + 1)
Name = Data(I + 0) Range("B" & counter).Value = Name
'Next
End If
Next
End If
Next
counter
End Sub
</code>Its giving me the output but its overwriting the first line with CD <code style="margin: 0px; padding: 1px 5px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; background-color: rgb(238, 238, 238); font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: pre-wrap; background-position: initial initial; background-repeat: initial initial;">CD /REPORT/CURRENT2</code> with <code style="margin: 0px; padding: 1px 5px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; background-color: rgb(238, 238, 238); font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: pre-wrap; background-position: initial initial; background-repeat: initial initial;">CD /UPLOAD</code> and its giving me only one output.Is there anyway to keep the both records with <code style="margin: 0px; padding: 1px 5px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; background-color: rgb(238, 238, 238); font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: pre-wrap; background-position: initial initial; background-repeat: initial initial;">LCD</code> and <code style="margin: 0px; padding: 1px 5px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; background-color: rgb(238, 238, 238); font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: pre-wrap; background-position: initial initial; background-repeat: initial initial;">CD</code>?

<code style="margin: 0px; padding: 0px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit;">Desired out put:

</code>[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]******Column A*****[/TD]
[TD] ******Colum B*****[/TD]
[/TR]
[TR]
[TD]input goes here.....[/TD]
[TD]CD /REPORT/CURRENT2 [/TD]
[/TR]
[TR]
[TD].....................[/TD]
[TD]CD /UPLOAD [/TD]
[/TR]
[TR]
[TD]...............[/TD]
[TD]LCD POWER.LST.X[/TD]
[/TR]
[TR]
[TD].....................[/TD]
[TD]LCD SAMPLE.TXT ​[/TD]
[/TR]
</tbody>[/TABLE]
<code style="margin: 0px; padding: 0px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit;"></code>

 

[RickXL]

I have not researched your macro in detail but this should work. Just increment a counter each time you write a line out:

<code style="margin: 0px; padding: 0px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit;">Sub Search2()
Dim MatchString As String
Dim matchstrin2 As String
Dim counter As Variant
Dim Name As StringDim 
Datain As String
MatchString = "CD "
MatchString2 = "CD  "
LineCount = 1
For counter = 1 To Range("A:A").Count
Datain = Range("A" & counter).Value
If (InStr(1, Datain, MatchString) > 0 Or InStr(1, Datain, MatchString2) > 0) Then
Data = Split(Datain, vbLf)
cnt = UBound(Data) 
   For I = 0 To cnt 
       If Data(I) Like "*CD /*" Then        'Temp = Split(Data(i), " ")        'Temp2 = (Data(i) + 1) 
       Name = Data(I + 0)        
       Range("B" & LineCount).Value = Name 
       LineCount = LineCount + 1
       'Next 
       End If 
       Next
End If
Next counter
End Sub

(JCL: I remember that!)
</code>

 

[Subhra Sankha Sardar]

I have not researched your macro in detail but this should work. Just increment a counter each time you write a line out:

<code style="margin: 0px; padding: 0px; border: 0px; font-size: 13.63636302947998px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit;">Sub Search2()
Dim MatchString As String
Dim matchstrin2 As String
Dim counter As Variant
Dim Name As StringDim 
Datain As String
MatchString = "CD "
MatchString2 = "CD  "
LineCount = 1
For counter = 1 To Range("A:A").Count
Datain = Range("A" & counter).Value
If (InStr(1, Datain, MatchString) > 0 Or InStr(1, Datain, MatchString2) > 0) Then
Data = Split(Datain, vbLf)
cnt = UBound(Data) 
   For I = 0 To cnt 
       If Data(I) Like "*CD /*" Then        'Temp = Split(Data(i), " ")        'Temp2 = (Data(i) + 1) 
       Name = Data(I + 0)        
       Range("B" & LineCount).Value = Name 
       LineCount = LineCount + 1
       'Next 
       End If 
       Next
End If
Next counter
End Sub

(JCL: I remember that!)
</code>

Thanks mate!!Its the MVS JCL the ancient kind.Really having a 'hard' time with this.I will check and let you know if its working or not.Much appreciated

 

[Subhra Sankha Sardar]

RickXL the results are coming but the seconf record is apending in the wrong place. Why?

 

[RickXL]

I didn't want to try and understand your code because it looked complicated. However, I think you need something like this.

I have counted the used rows to save it looping round a million of them and have discarded the bits that I did not understand!
I changed the search strings as well.

Sub Search2()
    Dim MatchString1 As String
    Dim MatchString2 As String
    Dim Counter As Long
    Dim Name As String
    Dim DataIn As String
    Dim LastRow As Long
    
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    MatchString1 = "CD /"
    MatchString2 = "LCD "
    LineCount = 1
    For Counter = 1 To LastRow
        DataIn = Range("A" & Counter).Value
        If (InStr(1, DataIn, MatchString1) > 0 Or InStr(1, DataIn, MatchString2) > 0) Then
            Range("B" & LineCount).Value = DataIn
            LineCount = LineCount + 1
        End If
    Next Counter
    
End Sub