Macro to manipulate lines of text Solved/Closed

Question

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

TrowaD · Answer

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 · Answer

Can anyone help me with the question I posed above?

TrowaD · Answer

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

TrowaD · Answer

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

TrowaD · Answer

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

TrowaD · Answer

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

TrowaD · Answer

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

TrowaD · Answer

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

TrowaD · Answer

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

Macro to manipulate lines of text

9 responses

Similar discussions

Subscribe To Our Newsletter!