Macro to manipulate lines of text [Solved]

Posts
3
Registration date
Thursday February 1, 2018
Last seen
February 1, 2018
-
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 

Your reply

9 replies

Posts
2440
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 13, 2018
0
Thank you
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
Posts
3
Registration date
Thursday February 1, 2018
Last seen
February 1, 2018
-
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
Posts
3
Registration date
Thursday February 1, 2018
Last seen
February 1, 2018
-
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.
Thanks for sharing it.
Respond to TrowaD
0
Thank you
Can anyone help me with the question I posed above?
Respond to Yuenja
Posts
2440
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 13, 2018
0
Thank you
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
Posts
2440
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 13, 2018
-
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: Basically I have two sheets in a workbook. Each sheet contains values related to same categories but each was reporting at different time periods.

I need to produce one sheet of data by first comparing two sheets based on one column's value. After that matching process, I would need to filter out some information in another column, And then I copy the information over to a new sheet in a certain order for me to do other things.

So the details are:

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 for column labels but not same value in column as Initial sheet

Match values in Column C (prod ID) on both sheets and using the matched value column C (prodID) ,
deselect from any row that has "Y-C" value in column F(Status) on Deactivate sheet.

By now, the newly matched and filtered rows in Deactivate sheet should only have row values that match column C in two sheets and has deselected out "Y-C" in column F.

Then copy from Deactivate sheet 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 a new sheet in the same workbook (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 a new Sheet3 in the same workbook.

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

For this last part, I was able to use this delimited script 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.
Respond to TrowaD
Posts
2440
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 13, 2018
0
Thank you
Hi Yuenja,

It is a little clearer.

Could you try the code below and comment on what it does right and wrong?

For it to work there needs to be a sheet called 'Sheet2'.

Here is the code:
Sub RunMe()
Dim mFind As Range
Dim lRow, lRow2 As Integer

Sheets("Initial").Select
lRow = Range("C" & Rows.Count).End(xlUp).Row

For Each cell In Range("C2:C" & lRow)

    Set mFind = Sheets("Deactivate").Columns("C").Find(cell.Value)
    If Not mFind Is Nothing Then
        If mFind.Offset(0, 3).Value <> "Y-C" Then
            With Sheets("Sheet2")
                lRow2 = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                .Range("A" & lRow2).Value = mFind.Offset(0, 10).Value
                .Range("B" & lRow2).Value = mFind.Offset(0, 8).Value
                .Range("C" & lRow2).Value = mFind.Offset(0, 10).Value
                .Range("D" & lRow2).Value = mFind.Offset(0, -1).Value
                .Range("E" & lRow2).Value = mFind.Offset(0, 1).Value
                .Range("F" & lRow2).Value = mFind.Value
            End With
        End If
    End If
Next cell
End Sub


What it does:
Each value in column C of sheet 'Initial' is compared to column C of sheet 'Deactivate'.
When a match is found and the value 'Y-C' is not found in column F of sheet 'Deactivate',
then columns M, K, M, B, D, C of sheet 'Deactivate' are copied to columns A, B, C, D, E, F of sheet 'Sheet2'

Question:
Are the Prod ID's unique or will there be more of the same in a column?


Hopefully we got a little closer to a solution.
Some query's are harder to explain as others, the same goes for understanding them. As long as you can wait for a reply, I'll be here to help you.

Best regards,
Trowa
HI Trowa, thanks for this first of all!!
To answer your question ProdIDs are unique for each field in each sheet but can be duplicates when you compare the two sheets, that's why I need to match them from two sheets.

Thank you so much for this !!!

I will test it out and let you know!

Yuenja
Hello TrowA
Yes, it works! Thank you so much again!.

The new Sheet2 shows up the way I described to you. What do I have to do add to your script in order to execute the following script in new Sheet2 for column F of new Sheet2 and put the new values in new Sheet3? Should I just run the script separately?

(The script is to create delimited values in column F: 123,456,789)
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
Respond to TrowaD
Posts
2440
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 13, 2018
0
Thank you
Hi Yuenja,

You can run the scripts separately or combine the 2 like this:

Sub RunBoth
call RunMe
call generatecsv
end sub

Just make sure to reference the right sheet in 'generatecsv'.

I do find it strange that I don't see any reference to column F, but I guess it works for you.

Best regards,
Trowa
Hi TrowA

Thank you again for this. I tested the macro you gave last week. it worked beautifully.

Thanks for your help. Have a good day and week!

Yuenja
-
Hello TrowA,

It's been a while that I asked a question. I would appreciate some help on VBA.

I used a

Sub sbCopyRangeToAnotherSheet()

Sheets("MM Data").Range("B2:zz200000").Copy Destination:=Sheets("Outlook Mail Merge").Range("a2:zz200000")

End Sub

The "problem" is that I rather have this be done as a loop to check for last column in source MM Data sheet and copy to Destination Outlook Mail Merge sheet And not make the range a pre-set one (in case the range becomes bigger and I have to adjust)

So my MM Data Sheet has
Row 1:column 1, 2, 3,4
Row 2: column 1,2,3,4,.....10
Row 3: column 1,2,3,4,....7
Row 4: column 1, 2,3, 4, 6
And I would like to copy the rows and columns (data included) to Outlook Mail Merge.I would also like to start in Row 1 to copy and paste.

The rows change in from one period to another and the columns will change in number from one row to another from periods to periods.

Thanks in advance..
Yuenja
Respond to TrowaD
Posts
2440
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 13, 2018
0
Thank you
Hey Yuenja,

Hopefully you are doing well.

See if the following code yields the desired result:
Sub sbCopyRangeToAnotherSheet()
Sheets("MM Data").Range("A1").CurrentRegion.Copy _
Sheets("Outlook Mail Merge").Range("A1")
End Sub


CurrentRegion will select all cells that are located next to each other with data in them.
You don't have to specify the destination range, as long as there is enough space to paste the data.

To not overwrite your previous copy/paste action use the following line instead of code line 3:
Sheets("Outlook Mail Merge").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)



Best regards,
Trowa
-
Hi Trowa,

Thank you for the help again. I modified your script a bit and it works for what I need to do. Thanks very much again!.

Yuenja
-
Hi Trowa,

I would need some help again.

I have been looking at RangeFind Macros and somehow cannot get one to work for my situation

The one I used does not return the column that I want

I have Columns A thru unknown #, and each row is populated but to Unknown row #
Example:
Col A Col B Col C Col D Col E Col F
Row1 x yy zzz 12
Row2 xyy yy zzz 34 78
Row3 x yy zzz 56 89 101
Row # x yy zzz 78

I would need to see that the Macro returns Column 5 to be the column that has any information.
However, the Macro I used here only gives a row count and when I switch to column count, it says column is 0.

Sub Range_Find_Method()
'Finds the last non-blank cell on a sheet/range.

Dim lRow As Long
Dim lCol As Long

lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

MsgBox "Last Row: " & lRow

End Sub

So I am asking for help again. I appreciate your help in advance.
Yuenja
Respond to TrowaD
Posts
2440
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 13, 2018
0
Thank you
No problem, I'm here to help you out Yuenja.

To find the last row used for a specific column:
lRow = Range("A" & Rows.Count).End(xlUp).Row

To find last column used for a specific row:
lCol = Cells(1, Columns.Count).End(xlToLeft).Column

To find the last row and last column used in your matrix:
With Range("A1").CurrentRegion
    lRow = .Rows.Count
    lCol = .Columns.Count
End With

To find the least amount of columns used in your matrix:
Dim lRow As Long
Dim lCol, x, y As Integer

lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Range("A1").CurrentRegion.Columns.Count

For x = lRow To 1 Step -1
    y = Cells(x, Columns.Count).End(xlToLeft).Column
    If y < lCol Then
        lCol = y
    End If
Next x


My doubt: When I look at your sample data and count the columns used for each row, I get to:
Row 1: 4 columns
Row 2: 5 columns
Row 3: 6 columns
Row #: 4 columns
Not sure how you would get to 5 columns as a result. Maybe first available column in the last row used?

I'll wait for your feedback.

Best regards,
Trowa
-
Hello Trowa,
I used the rangefind method for the column and row count and the command worked. I wanted a column count for the max number of columns used in any row.

I would also save the other macros you provided for each individual column count of rows. They will come in handy when I need to do this later. And I have a question, how do you get the macro to show you the column count in each row? Just like the one you listed here?

Thanks in advance again! Thanks for such a quick turnaround help!

yuenja
Respond to TrowaD
Posts
2440
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 13, 2018
0
Thank you
Hi Yuenja,

'I wanted a column count for the max number of columns used in any row. '
lCol = Range("A1").CurrentRegion.Columns.Count


'how do you get the macro to show you the column count in each row? '
How would you like the macro to show you the coumn count for each row? Do you want to reserve a column for the results? Do you want message boxes to appear for each row?

Best regards,
Trowa
Hi Trowa.

First of all thank you for the response.
I would like them to appear at a new sheet column count for each row. Where do you insert the script based on your solution posted earlier
(See
Dim lRow As Long
Dim lCol, x, y As Integer

lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Range("A1").CurrentRegion.Columns.Count

For x = lRow To 1 Step -1
y = Cells(x, Columns.Count).End(xlToLeft).Column
If y < lCol Then
lCol = y
End If
Next x)

Thank you very much again!
Respond to TrowaD
Posts
2440
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 13, 2018
0
Thank you
Hi Yuenja,

Put the script in a standard module.

But that script was to determine the least amount of rows used in the matrix.

Try the code below where 'YourSheetNameHere' refers to the sheet you want to count the columns for.
The sheet name 'DestinationSheet' refers to the sheet where the column count is placed in column A.
Adjust those references to match your sheet names.

Sub RunMe()
Dim lRow As Long
Dim lCol, x As Integer

Sheets("YourSheetNameHere").Select

lRow = Range("A" & Rows.Count).End(xlUp).Row

For x = lRow To 1 Step -1
    lCol = Cells(x, Columns.Count).End(xlToLeft).Column
    Sheets("DestinationSheet").Range("A" & x).Value = lCol
Next x
End Sub


Best regards,
Trowa
Hi Trowa
Thank you for your help. The commands work. I will be using them in many areas.
Thanks. And have a good day!
Yuenja
TrowaD
Posts
2440
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 13, 2018
-
Awesome, have a good day yourself!
Respond to TrowaD