Issues With VBA Macro For Transposing Using Named Range

[Legacy 363566]

Hello!

I have been working on this issue all day, so I am hoping someone here is able to help. I am trying to create a VBA script that will allow me to easily complete a copy > paste special (transpose) operation.

1. I need to select a custom range of data
2. Loop through the data by row
2.1 If the cell of the first column is not null I need to check if there is data in the following columns
2.2 If there is data in the following columns, I need all the data to be copied
3. I need to do a special paste of the data, so it can be transposed, below the cell in the first column of the row

Here is an illustration of what I am saying:
https://drive.google.com/open?id=0B7RoI5-NVRVfMEFTRmp2b3lyeEk

Here is what the spreadsheet needs to look like once the script has completed:
https://drive.google.com/open?id=0B7RoI5-NVRVfUDJtMmZQd0h1bjg

Here is my code (I get runtime error):

<code>Sub PhotoColumnsToRows()

'We need to know where the photo URL's are located
Dim rng As Range
Set rng = Application.InputBox(Prompt:= _
            "Please select a range.", _
                Title:="SPECIFY RANGE", Type:=8)


'Now we need to scan the range of data for URL's, skipping blank rows/cells
For Each row In rng
    If Not IsNull(rng.Column) Then
        copyRow = rng.row
        Rows(copyRow & ":" & copyRow).Select
        Selection.Copy

        Sheets("Sheet2").Select
        ActiveSheet.Rows(copyRow).Select
        ActiveSheet.PasteSpecial Transpose:=True
        Sheets("Sheet1").Select
    End If
Next row
End Sub</code>

Thank you in advance!

PS: I am using Excel 2011 on a Mac

 

[Legacy 363566]

if i my paraphase what you are after then

Look at Column J for any URL's
if URL is found look to the right to see if there are any other URLS
if some do exist then put underneath the the URL in column J

but only do this for the section you highlight or for the whole thing but just leave your headers alone?

I actually sent you a link to my csv file in a private message.

 

[Legacy 363566]

Sub ColsToRows()

Dim rng As Range
Set rng = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)

For Each Row In rng
    If Not IsNull(rng.Row) Then
        ActiveCell.Resize(1, 4).Copy
        ActiveCell.PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=True
    End If
Next

End Sub

This is my latest code. I am still having issues.

 

[humdingaling]

Sub PhotoColumnsToRows()
   
    Dim i As Long 'row counter
    Dim j As Long 'URL counter - For counting amount of URLs to add
    Dim LRow As Long 'last row
    
    Application.ScreenUpdating = False 'turn screen updating off to stop flickering
        
    LRow = Cells(Rows.Count, "A").End(xlUp).Row 'determine current last row
        
    i = 2 'start at row 2
    
    Do While i < LRow
        
        If IsEmpty(Cells(i, 11)) = False Then 'checks column K for data
            
            j = Application.WorksheetFunction.CountA(Range(Cells(i, 11), Cells(i, 13))) 'counts amount of Urls between K and M
            
            Rows(i + 1 & ":" & i + j).Insert 'insert amount of rows found from countA
            Range(Cells(i, 11), Cells(i, 11 + j - 1)).Copy 'copies specific range based on CountA
            Cells(i + 1, 10).PasteSpecial Transpose:=True 'pastespecial transpose below "J"
            Range(Cells(i, 11), Cells(i, 11 + j - 1)).ClearContents 'clear previously copied data
            LRow = LRow + j 'increments last row by the number of rows added
            
        
        End If
        
        i = i + 1 'increment loop
    Loop
        
    Application.ScreenUpdating = True 'turn back on screen updating
    
End Sub

here's what i ended up with
as your file is rather large...give it a sec to run the code

 

[humdingaling]

I've used column K as the first check instead of J because...well if J isnt empty but K is then nothing happens

 

[Legacy 363566]

Sub PhotoColumnsToRows()
   
    Dim i As Long 'row counter
    Dim j As Long 'URL counter - For counting amount of URLs to add
    Dim LRow As Long 'last row
    
    Application.ScreenUpdating = False 'turn screen updating off to stop flickering
        
    LRow = Cells(Rows.Count, "A").End(xlUp).Row 'determine current last row
        
    i = 2 'start at row 2
    
    Do While i < LRow
        
        If IsEmpty(Cells(i, 11)) = False Then 'checks column K for data
            
            j = Application.WorksheetFunction.CountA(Range(Cells(i, 11), Cells(i, 13))) 'counts amount of Urls between K and M
            
            Rows(i + 1 & ":" & i + j).Insert 'insert amount of rows found from countA
            Range(Cells(i, 11), Cells(i, 11 + j - 1)).Copy 'copies specific range based on CountA
            Cells(i + 1, 10).PasteSpecial Transpose:=True 'pastespecial transpose below "J"
            Range(Cells(i, 11), Cells(i, 11 + j - 1)).ClearContents 'clear previously copied data
            LRow = LRow + j 'increments last row by the number of rows added
            
        
        End If
        
        i = i + 1 'increment loop
    Loop
        
    Application.ScreenUpdating = True 'turn back on screen updating
    
End Sub

here's what i ended up with
as your file is rather large...give it a sec to run the code

Wowza! That worked PERFECTLY!! Thanks a million!

Cheers