Macro to manipulate lines of text [Solved]

yuenja 3 Posts Thursday February 1, 2018Registration date February 1, 2018 Last seen - Feb 1, 2018 at 10:34 AM - Latest reply:  yuenja
- Feb 16, 2018 at 03:00 PM
I have data that is arranged as this in four columns

x emailx nameofx 123
x emailx nameofx 4456
x emailx nameofx 67
y emaily nameofy 12
z emailz nameofz 45
z emailz nameofz 7

I would like to arrange them as this in two columns

x emailx
x nameofx
x 123
x 4456
x 67
y emaily
y nameofy
y 12
z emailz
z nameofz
z 45
z 7
See more 

10 replies

Reply to this topic
TrowaD 2299 Posts Sunday September 12, 2010Registration dateModeratorStatus February 15, 2018 Last seen - Feb 1, 2018 at 11:49 AM
0
Helpful
2
Hi Yuenja,

Assuming the four columns are located in columns A:D without header. Then the code below will place the desired result in columns F:G.

Here is the code:
Sub RunMe()
Dim lRow As Integer

lRow = Range("A1").End(xlDown).Row

For Each cell In Range("A1:A" & lRow)
    On Error Resume Next
    If cell.Value <> cell.Offset(-1, 0).Value Then

        Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value
        Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, 1).Value
        
        Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value
        Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, 2).Value
        
        Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value
        Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, 3).Value
    
    Else
    
        Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value
        Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, 3).Value
        
    End If
    
Next cell
End Sub


Best regards,
Trowa
yuenja 3 Posts Thursday February 1, 2018Registration date February 1, 2018 Last seen - Feb 1, 2018 at 12:49 PM
Thank you v much, the original data set in column D is too long and generated an overflow, it is also a combo of values and text, what do I do?
yuenja 3 Posts Thursday February 1, 2018Registration date February 1, 2018 Last seen - Feb 1, 2018 at 02:54 PM
Hi, I think the macro works after testing it on another dataset. How do I combine two macros? Basically, I ran the RunMe , I want to immediately run a TransposeData.

So after the RunME operation, my dataset looks like this
x emailx
x nameofx
x 123
x 4456
x 67
y emaily
y nameofy
y 12
z emailz
z nameofz
z 45
z 7

And I need to make it to look like this

x emailx nameofx 123 4456 67
y emaily nameofy 12
z emailz nameofz 45 7

To get it to look like this, I currently would have to copy and paste the results of RunMe to another worksheet and execute this

Sub TransposeData()
Dim rFrom As Range
Dim rTo As Range
Dim iRows As Integer
Set rFrom = ActiveSheet.Range("A1") ' assumes data starts at A1 on active sheet
Set rTo = ActiveWorkbook.Worksheets.Add.Range("A1")
Do Until IsEmpty(rFrom.Value)
iRows = 1
Do While rFrom.Value = rFrom.Offset(iRows).Value
iRows = iRows+1
Loop
rTo.Value = rFrom.Value
rTo.Offset(,1).Resize(,iRows) = Application.Transpose(rFrom.Offset(,1).Resize(iRows))
Set rFrom=rFrom.Offset(iRows)
Set rTo=rTo.Offset(1)
Loop
End Sub

I want to bypass this step of copy and paste the RunMe result to another sheet.
I just want to run one macro to do two things.

Thanks in advance.
Respond to TrowaD
0
Helpful
Can anyone help me with the question I posed above?
Respond to Yuenja
TrowaD 2299 Posts Sunday September 12, 2010Registration dateModeratorStatus February 15, 2018 Last seen - Feb 5, 2018 at 12:15 PM
0
Helpful
5
Hi Yuenja,

How about using this code:
Sub RunMe()
Dim lRow, lRow2 As Long

lRow = Range("A1").End(xlDown).Row

For Each cell In Range("A1:A" & lRow)
    On Error Resume Next
    If cell.Value <> cell.Offset(-1, 0).Value Then
        
        lRow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        
        Sheets("Sheet2").Range("A" & lRow2).Value = cell.Value
        Sheets("Sheet2").Range("B" & lRow2).Value = cell.Offset(0, 1).Value
        Sheets("Sheet2").Range("C" & lRow2).Value = cell.Offset(0, 2).Value

        Sheets("Sheet2").Cells(lRow2, Columns.Count).End(xlToLeft).Offset(0, 1).Value = cell.Offset(0, 3).Value
    
    Else
    
        Sheets("Sheet2").Cells(lRow2, Columns.Count).End(xlToLeft).Offset(0, 1).Value = cell.Offset(0, 3).Value
        
    End If
    
Next cell

'Sheets("Sheet2").Rows(1).Delete
End Sub


Note that the destination sheet is called: Sheet2.
Also note that the second to last line ('Sheets("Sheet2").Rows(1).Delete) doesn't do anything until you remove the apostrophe. This in case you have some data in the 1st row of the destination sheet, you don't want to lose.

Best regards,
Trowa
Hello TrowaD

I don't know if I should ask you again for VBA help. I hope you would be able to find time to help.

I have a situation whereby I have two sheets of data , call it Initial and Deactivate.
In each sheet the column labels are the same.

I want to match values in column C in sheet 1(Initial) with values in column C (product id) in sheet 2 (Deactivate), and at the same time, exclude all values in column F "Y-C" from sheet 2 (Deactivate) when I do the match.

After the matching, I just want to copy and paste the data associated with the newly matched column C as follows
from Sheet 2 (Deactivate) Column C (product id), Column A, Column M, column K, column M, column B, column D to a new sheet2 .

And in this new sheet2 I have a script to convert column C (product id) data to have commas separating the values out and again to output these values to a new row in a third sheet.

I know this sounds a bit much. I got the VBA for the comma delimited as follows

Function csvRange(myRange As Range)
Dim csvRangeOutput
Dim entry As Variant
For Each entry In myRange
If Not IsEmpty(entry.Value) Then
csvRangeOutput = csvRangeOutput & entry.Value & ","
End If
Next
csvRange = Left(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function

Many thanks in advance.
TrowaD 2299 Posts Sunday September 12, 2010Registration dateModeratorStatus February 15, 2018 Last seen - Feb 15, 2018 at 11:27 AM
hi Yuenja,

I'm having some trouble understanding your question.

My understanding now is that you want to compare column C from sheet 'Initial' to column C from sheet 'Deactivate'. When there is a match, you want to copy columns A, B, C, D, K and M from sheet 'Deactivate' to sheet 'sheet2'.

Example:
Sheet 'Initial'
Column C
1
2
3

Sheet 'Deactivate'
Column A, B, C, D, K, M
a, a, a, a, a, a
b, b, 3, b, b, b
c, c, c, c, c, c

Result:
Sheet 'Sheet2'
Column A, B, C, D, K, M
b, b, 3, b, b, b

Am I on the right track?

Best regards,
Trowa
Hi Trowa,

Sorry if it was not clear.

Here is the situation:
Sheet Initial: A (FirmID) , B(FirmName) , C (prod ID), D (Prod Name), E, F..(Status).....K(FirstName) M(email)....
Sheet Deactivate: A, B, C, D, E, F....K...M .same type of info as Initial sheet

Match Column C (prod ID) on both sheets
Deselect from the matched column any row that has "Y-C" in column F(Status) on Deactivate .

So the newly matched and filtered rows should only have values that match C in two sheets and has deselected out "Y-C" in column F.

Then copy from Deactivate based on the new screened and matched info, these columns M (email), K(FirstName),M (email) ,B Firm Name) ,D (Prod Name), C (Prod ID) into new sheet (Sheet2) in that order(that is Column M start in column 1 of the Sheet2 and etc).

On the newly formed Sheet2, turn information in column C (Prod ID)which is now the last column on the new Sheet2 into a delimited value row onto Sheet3.

So if column c has: 123
456
789
then Column C will show up as 123,4546,789 in Sheet 3 as a row of information
I got the delimited script as this for column C

Sub generatecsv()
Dim i As Integer
Dim s As String

i = 1

Do Until Cells(i, 1).Value = ""
If (s = "") Then
s = Cells(i, 1).Value
Else
s = s & "," & Cells(i, 1).Value
End If
i = i + 1
Loop

Cells(1, 2).Value = s

End Sub

Many thanks for your help in advance again!!! And I hope I explained the situation to you more clearly this time.
Hi TrowaD, I hope you got a chance to read my reply to your question for more clarification of my VBA script question posted above. If not, have a good weekend and I hope You would find time to help me.

Many thanks in advance again!!
Yuenja
Respond to TrowaD