mtthompsons

asked on 9/14/2015

Copy and merge specific column content Urgent help please with excel macro

Hi All,

Attached file has 2 sheets 1 is what i have a raw file with 20K rows of data and i want it finally as "Output" sheet

Need to get the name from column "C" and than trim the code after = and place all thats related to it next to each other with coma delimited

The Youtube one i can actually remove all if needed and have the unique YT no alone in the cells

Any Help is highly helpful

thank you
Macro-Help.xlsx

Microsoft Excel

Last Comment

Subodh Tiwari (Neeraj)

8/22/2022 - Mon

SOLUTION

Saurabh Singh Teotia

9/14/2015

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.

View this solution by signing up for a free trial.

Members can start a 7-Day free trial and enjoy unlimited access to the platform.

See Pricing Options

Start Free Trial

GET A PERSONALIZED SOLUTION

Ask your own question & get feedback from real experts

Find out why thousands trust the EE community with their toughest problems.

mtthompsons

9/14/2015

ASKER

I get runtime error 7

Out of memory

When i click debug goes here
str = Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - InStr(1, ws.Cells(i, "g").Value, "=", vbTextCompare))

Just first entry shows up
143 Nooranalavathmuru

Saurabh Singh Teotia

9/14/2015

Use this code..

Sub movedata()
    Dim ws As Worksheet
    Dim ws1 As Worksheet

    Set ws = Sheets("Sheet1")
    Set ws1 = Sheets("Ouput1")

    ws1.Cells.Clear

    Dim cell As Range, lrow As Long, lr As Long
    Dim rng As Range, i As Long
    Dim str As String

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("C2:C" & lrow)

    For Each cell In rng
        If Trim(cell.Value) <> "" Then
            If ws1.Cells(1, 1).Value = "" Then
                lr = 1
            Else
                lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            End If
            cell.Copy
            ws1.Range("A" & lr).PasteSpecial xlPasteValues
            str = ""
            i = cell.Row
            Do Until Trim(ws.Cells(i, "g").Value) = ""
                If InStr(1, ws.Cells(i, "g").Value, "=", vbTextCompare) > 0 Then
                    If str = "" Then
                        str = Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - InStr(1, ws.Cells(i, "g").Value, "=", vbTextCompare))
                    Else
                        str = str & "," & Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - InStr(1, ws.Cells(i, "g").Value, "=", vbTextCompare))
                    End If
                End If

                i = i + 1

            Loop
            ws1.Range("B" & lr).Value = str

        End If

    Next cell

    ws1.Cells.EntireColumn.AutoFit
End Sub

Open in new window

Saurabh...

mtthompsons

9/14/2015

ASKER

Same error

If InStr(1, ws.Cells(i, "g").Value, "=", vbTextCompare) > 0 Then

Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!

Walt Forbes

Saurabh Singh Teotia

9/14/2015

It runs for me without any problem..Can you post your sample original file where you are running this code..Also did you change the ws name at the starting which is..

Set ws = Sheets("Sheet1")

This to the worksheet name which you want to refer to?? So if you want to refer to sheet5 this will be..

Set ws=Sheet("Sheet")

Saurabh...

mtthompsons

9/14/2015

ASKER

I am actually using the file you attached and in that file i get this issue

I have Excel 2011 for Mac would that be an issue?

Saurabh Singh Teotia

9/14/2015

Yeah that can be the issue as that feature not available in it..Let me try to change this for you...

Try this one...

Sub movedata()
    Dim ws As Worksheet
    Dim ws1 As Worksheet

    Set ws = Sheets("Sheet1")
    Set ws1 = Sheets("Ouput1")

    ws1.Cells.Clear

    Dim cell As Range, lrow As Long, lr As Long
    Dim rng As Range, i As Long
    Dim str As String

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("C2:C" & lrow)

    For Each cell In rng
        If Trim(cell.Value) <> "" Then
            If ws1.Cells(1, 1).Value = "" Then
                lr = 1
            Else
                lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            End If
            cell.Copy
            ws1.Range("A" & lr).PasteSpecial xlPasteValues
            str = ""
            i = cell.Row
            Do Until Trim(ws.Cells(i, "g").Value) = ""

                If str = "" Then
                    str = Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - Application.WorksheetFunction.Find("=", ws.Cells(i, "g").Value, 1))
                Else
                    str = str & "," & Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - Application.WorksheetFunction.Find("=", ws.Cells(i, "g").Value, 1))
                End If

                i = i + 1

            Loop
            ws1.Range("B" & lr).Value = str

        End If

    Next cell

    ws1.Cells.EntireColumn.AutoFit
End Sub

Open in new window

Workbook...

Saurabh...
Macro-Help.xlsm

⚡ FREE TRIAL OFFER

Try out a week of full access for free.

Find out why thousands trust the EE community with their toughest problems.

mtthompsons

9/14/2015

ASKER

Now it works for 45 rows and than get the attached error

str = Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - Application.WorksheetFunction.Find("=", ws.Cells(i, "g").Value, 1))
Screen-Shot-2015-09-15-at-12.47.45-a.png

mtthompsons

9/14/2015

ASKER

It failed on row 11 as attached is it because of N/A

If N/A can we skip and move to next
Screen-Shot-2015-09-15-at-12.49.54-a.png

Saurabh Singh Teotia

9/14/2015

Use this..

Sub movedata()
    Dim ws As Worksheet
    Dim ws1 As Worksheet

    Set ws = Sheets("Sheet1")
    Set ws1 = Sheets("Ouput1")

    ws1.Cells.Clear

    Dim cell As Range, lrow As Long, lr As Long
    Dim rng As Range, i As Long
    Dim str As String

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("C2:C" & lrow)

    For Each cell In rng
        If Trim(cell.Value) <> "" Then
            If ws1.Cells(1, 1).Value = "" Then
                lr = 1
            Else
                lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            End If
            cell.Copy
            ws1.Range("A" & lr).PasteSpecial xlPasteValues
            str = ""
            i = cell.Row
            Do Until Trim(ws.Cells(i, "g").Value) = ""
                If IsNumeric(Application.WorksheetFunction.Find("=", ws.Cells(i, "g").Value, 1)) Then
                    If str = "" Then
                        str = Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - Application.WorksheetFunction.Find("=", ws.Cells(i, "g").Value, 1))
                    Else
                        str = str & "," & Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - Application.WorksheetFunction.Find("=", ws.Cells(i, "g").Value, 1))
                    End If
                End If

                i = i + 1

            Loop
            ws1.Range("B" & lr).Value = str

        End If

    Next cell

    ws1.Cells.EntireColumn.AutoFit
End Sub

Open in new window

Workbook..

Saurabh...
Macro-Help.xlsm

Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!

James Murphy

mtthompsons

9/14/2015

ASKER

I get runtime error 1004

If IsNumeric(Application.WorksheetFunction.Find("=", ws.Cells(i, "g").Value, 1)) Then

Screenshot attached
Screen-Shot-2015-09-15-at-12.54.22-a.png

Saurabh Singh Teotia

9/14/2015

This is because of your mac..Do you get the error in this one too??

Sub movedata()
    Dim ws As Worksheet
    Dim ws1 As Worksheet

    Set ws = Sheets("Sheet1")
    Set ws1 = Sheets("Ouput1")

    ws1.Cells.Clear

    Dim cell As Range, lrow As Long, lr As Long
    Dim rng As Range, i As Long
    Dim str As String

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("C2:C" & lrow)

    For Each cell In rng
        If Trim(cell.Value) <> "" Then
            If ws1.Cells(1, 1).Value = "" Then
                lr = 1
            Else
                lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            End If
            cell.Copy
            ws1.Range("A" & lr).PasteSpecial xlPasteValues
            str = ""
            i = cell.Row
            Do Until Trim(ws.Cells(i, "g").Value) = ""
                If (Mid(Trim(ws.Cells(i, "g").Value), 31, 1)) = "=" Then
                    If str = "" Then
                        str = Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - Application.WorksheetFunction.Find("=", ws.Cells(i, "g").Value, 1))
                    Else
                        str = str & "," & Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - Application.WorksheetFunction.Find("=", ws.Cells(i, "g").Value, 1))
                    End If
                End If

                i = i + 1

            Loop
            ws1.Range("B" & lr).Value = str

        End If

    Next cell

    ws1.Cells.EntireColumn.AutoFit
End Sub

Open in new window

Workbook..

Saurabh..
Macro-Help.xlsm

mtthompsons

9/14/2015

ASKER

str = Right(ws.Cells(i, "g").Value, Len(ws.Cells(i, "g").Value) - Application.WorksheetFunction.Find("=", ws.Cells(i, "g").Value, 1))

I get this now
Screen-Shot-2015-09-15-at-1.03.08-am.png

⚡ FREE TRIAL OFFER

Try out a week of full access for free.

Find out why thousands trust the EE community with their toughest problems.

Saurabh Singh Teotia

9/14/2015

I'm not sure why you are getting this error now..Can you post the line where it gives you an error..or post your revised workbook..?? Or you can try in windows

mtthompsons

9/14/2015

ASKER

Code from : ID: 40976946

Works fine on Windows but as attached some wrong data is picked...

Where N/A the data from next fields is captured and becomes duplicate
File.JPG

mtthompsons

9/14/2015

ASKER

Another issue is some places content is as attached

In such cases the data is Outputted as below

Vascodigama kx7tWqxKzR8 ,J2ICRG9Et2A ,b62gI1T--Gg ,SEKMaBpxoDs
File.JPG

All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat

William Peck

mtthompsons

9/15/2015

ASKER

Hi Saurabh any luck...

Saurabh Singh Teotia

9/15/2015

mtthompsons,

Can you give me your revised file where the data looks like this and where you see it's failing..so that i can look over the same and can check and confirm..

Saurabh...

ASKER CERTIFIED SOLUTION

Subodh Tiwari (Neeraj)

9/15/2015

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.

View this solution by signing up for a free trial.

Members can start a 7-Day free trial and enjoy unlimited access to the platform.

See Pricing Options

Start Free Trial

GET A PERSONALIZED SOLUTION

Ask your own question & get feedback from real experts

Find out why thousands trust the EE community with their toughest problems.