Need help copying cells from one sheet to another..

[paulked]

Thanks Sam, I should have been more pedantry in my wording.

@ Jett I was trying to point out that copying modules and renaming them keeps a copy of the routines in both modules. These 'old' routines should be renamed (or deleted) otherwise you will get an Ambiguous Name error.

[JETTLIFE]

paulked - thank you so much again for your continued help with this! You are correct in assuming i needed the data to be shown in a new sheet so then people on my team can name it whatever when they send out to others. I had to make a couple tiny tweaks to make it work though which i highlighted below for anyone to have should this post be useful to them . had 2 bugs, 1) VBA debugger would pop up and alert that there was no sheet named "URL List 1", so i add logic to create the sheet if it doesn't exist in probably the worst way ever considering how streamlined your code is, but hey it works! 2) i had to change the part that deletes the blank rows to column D instead of C because of the new inserted column in A. This works perfect though sir! I also added at the very end a way to delete the temp sheet the vba was using so i dont have two identical tabs. This is sooo freaking fast, i still am dumb founded and impressed how fast you made this script. Thank you like x100!

Sub GetURLs003()    Application.ScreenUpdating = False
    Dim ar As Variant, Meta As String, shMeta As Worksheet, shDest As Worksheet
    Dim i As Long, j As Long, ar1() As Variant, e As Long, lr As Long
    Dim TempSheet As String
    Dim checkSheetName As String
    TempSheet = "URL Temp Sheet"
    'Get source sheet name
    If Len(Range("A6")) < 2 Then
        Meta = InputBox("Please Enter the tab name for your Metadata")
        Range("A6") = Meta
    Else
        Meta = Range("A6")
    End If
    'Check sheet exists
    On Error Resume Next
    Set shMeta = Sheets(Meta)
    On Error GoTo 0
    If shMeta Is Nothing Then MsgBox "That sheet doesn't exist!": Exit Sub
    On Error Resume Next
    checkSheetName = Worksheets(TempSheet).Name
    If checkSheetName = "" Then
        Worksheets.Add.Name = TempSheet
        'MsgBox "The sheet named ''" & TempSheet & _
        '"'' does not exist in this workbook but it has been created now.", _
        'vbInformation, "Intouch SEO Automation for Excel"
         Else
        'MsgBox "The sheet named ''" & TempSheet & _
        '"''exist in this workbook.", vbInformation, "Intouch SEO Automation for Excel"
        'Worksheets(TempSheet).Activate       'Selects worksheet
           'ActiveSheet.UsedRange.Delete                'deletes the used range of cells to clear the sheet
            'Range("a1").Select
    End If
'Set sheet names
    Set shDest = Sheets(TempSheet)
    'Put source int array
    ar = shMeta.UsedRange
    'Loop through data and write to new array ignoring formula errors on data page!
    For i = 8 To UBound(ar, 1)
        For j = LBound(ar, 2) To UBound(ar, 2)
            If LCase(Left(ar(i, j), 10)) = "site page:" Then
                On Error GoTo Nxt
                e = e + 1
                ReDim Preserve ar1(4, e)
                ar1(1, e) = ar(i, j)
                ar1(2, e) = ar(i, j + 1)
            End If
            If LCase(Left(ar(i, j), 8)) = "page url" Then
                On Error GoTo Nxt
                ar1(3, e) = ar(i, j)
                ar1(4, e) = ar(i, j + 1)
            End If
Nxt:
        On Error GoTo -1
        Next
    Next
    On Error GoTo 0
    'Clear destination sheet and write new array
    With shDest
        .Cells.ClearContents
        .Range("A1:E" & UBound(ar1, 2) + 1) = WorksheetFunction.Transpose(ar1)
        'Delete unwanted column
        .Columns("D:D").EntireColumn.Delete
        'Add headers
        .Range("A1") = Format(Now, "m/d/yyyy h:mm:ss AM/PM")
        .Range("B1") = "Page #"
        .Range("C1") = "Page Name"
        .Range("D1") = "Page URL"
        .Range("E1") = "Notes"
        'Delete blank data rows
        lr = .Cells(Rows.Count, 2).End(3).Row
        .Range("D1:D" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
    'Add a new sheet and copy new data to it
    With Sheets.Add
        .Name = "URL List" ' & Format(Now, "DD-MMM HH.MM")
        .Tab.Color = vbGreen
        shDest.Range("A1").CurrentRegion.Copy .Range("A1")
        .Columns("A:E").Columns.AutoFit
    End With
    Sheets("URL List").Activate
   'Delete temp sheet
    Application.DisplayAlerts = False
    Worksheets(TempSheet).Delete
    Application.DisplayAlerts = True
End Sub

[paulked]

Great stuff. I didn't put a check in for the URL List 1 sheet as I was creating a new sheet so assumed it would always be there

For your next part, comparing the two sheets, I have a better way of selecting the Old and Newest sheets the user wants to compare. I'll pop that routine in here later on or tomorrow morning.

One question before I do that, Is the sheet just generated always the latest one to compare with old data?

[paulked]

Using this should eliminate any typing errors when the user needs to input a sheet name.

The instructions of how to implement the code are included in the workbook. Image of sheet entry:

67163a.png

[JETTLIFE]

Interested for sure, and to answer your question - yes. Thanks again for all your help here sir!

[paulked]

In that case mymetadataInputValue2 = "URL List 1", no need for user input

[JETTLIFE]

paulked - you da f****** man! I have learned so much from this stepped approach of the knowledge share my friend. I am blown away how much more efficient and effective these coding best practices are. Id be willing to tip you for your time sir, this has not only helped me complete my task, but go above and beyond and landed me a new opportunity within my company by telling my boss today that it went from 86 secs to under 1 second by reaching out to smarter fellows than myself on this forum. Now they going to reach out to the company wide to see what i can help automate, and help change my workload to at least 10% VBA problem solving tasks like i been wanting really bad lately vs client work wheel spinning work that i have my associate do most of. This all thanks to you being kind and helping me out paulked! . I did some reading about arrays in VBA and some reviewing of declaring variables best practices and your code is making a lot more sense. And hoping i can use this info to better optimize all my scripts.

I will upload the final workbook tomorrow after i compile that bad ass sheet selector into the code and i really appreciate the clear guidance on that too man!

:Post tags for others (these are some of my google searches i made from my browser history trying to create this VBA Automated Solution): VBA cells with text that contain, VBA Find cells with text that contain, auto find cells with text, search rows for cells that contain specific text, excel vba find value in column, find text in cell excel vba, for next loop vba find cell value control, vba cells.find search direction, vba find 2 adjacent cells with specific text, copy and paste, vba find cell with specific text, vba find cell with string select 1 extra column and row below, vba macro to find text offset column/row and copy, vba to find all text that contains and copy to new sheet, vba to find and copy 1st match to new sheet, vba to find and copy all that match to new sheet, vba to find and select all that match, vba to find cell containing text, vba to find cell that contains and copy to new sheet, vba to find text in a cell.

Shoot me an email if interested in that $ tip or to chat offline - thank you so much again! I personally am shocked how kind this community is here.

[paulked]

That's great news! This is a brilliant forum and it's great to help people, the bonus for me is gaining more knowledge of VBA and making my, and hopefully others, life easier... no need for tips!

Best of luck in your pursuits and we're always here when you need us

[snb]

@Paulk

Why not simply Data Validation ?

[paulked]

It is selected during macro run (it was through an input box). It could, of course, be selected 1st!

[JETTLIFE]

As promised above - here is the final version of my workbook with the handy sheet selector form paulked(you are amazing!) provided - again - many thanks to all your help. Link to final workbook -> https://drive.google.com/file/d/1nsn...ew?usp=sharing

paulked - i rolled this out to my team in a handy little auto-setup tool(https://drive.google.com/open?id=1y0...STZdRLriA_JKNH), which worked great. But of course, all users are creative and found some special use cases here - is there anyway to modify the VBA that scans through the rows looking for text that contains, to only search visible rows? so if someone has a page hidden, it would not be pulled into the generated URL list? Any thoughts or directions here would be greatly appreciated

[paulked]

That's all great, I'm really pleased it's worked out for you. To exclude the hidden cells try adding the bit in red:

ar = shMeta.UsedRange.SpecialCells(xlCellTypeVisible)

I haven't tested it, but it could do the trick!!

[JETTLIFE]

Tried that, for some reason it is getting hung up on the 3rd line after the comment "'Clear destination sheet and write new array"

.Range("A1:E" & UBound(ar1, 2) + 1) = WorksheetFunction.Transpose(ar1)

It would be great if you could lead me to an article or two or explain this array script to me so I can troubleshoot this, sorry to be a pest..

[paulked]

It worked ok for me, see attached file (and yes, it is 02:30!).

File won't upload so here's a link

snb has a great site http://www.snb-vba.eu/VBA_Arrays_en.html

[JETTLIFE]

Lol, ima try this in a min when I get home for sure bro, thanks!

FYI- here my time zone rn.
Central Daylight Time
Time zone in Johnson County, KS (GMT-5)
Wednesday, May 20, 2020, 9:42 PM

[JETTLIFE]

Just tried it again and having the same issue. To confirm, if you hide rows say rows 12-19 or 66-72, you do not get a VBA runtime error? or an incomplete list that stops at row 72? Thanks for the resource sir! i will look into first thing (on my side of the world) and see if i can figure it out. You have been so helpful!

[paulked]

I've seen the error! I'll have a look into it.

[paulked]

Okay, think I've got it. Add a 'Helper' sheet and name it Help (you can hide it if you wish) then replace

ar = shMeta.UsedRange.SpecialCells(xlCellTypeVisible)

with

    Sheets("Help").Cells.ClearContents
    shMeta.UsedRange.SpecialCells(xlCellTypeVisible).Copy
    Sheets("Help").Range("A1").PasteSpecial xlPasteValues
    ar = Sheets("Help").UsedRange

Hope that works for you, worked for me hiding either of those groups of rows you mentioned and both together.

[JETTLIFE]

So yes, this worked for the example I provided, however one of my own client workbooks it is throwing error after I added script to check if the sheet exists, if not creates and hides, all with no prompts. Same bit of code used for creating the URL List tab but with all prompts removed, and inside the first script In the module that sets up the URL Wizard. So I spent an hour today reading on the site you shared. I do love the way that person writes there content very much. And gave me ALOT of useful information and tips. Led me to the bigger solution here, which is creating an ADD-IN that I can remotely update so all 23 peeps don't have to redo the work we required to be done by today lol. The biggest issue found was the searching for rows started at row 8, not like 2 (Which I changed to after reading about the code you created paulked _)
Here is the workbook with issues - again, still not able to upload...

The problem, is the sheet does not populate any data with the last two modifications. I need for users to be able to drag and drop into workbook, hit F5 into the first block of VBA to setup UX buttons and use from there. however i cant figure out how to make this thing work, as i don't get the purpose of the Temp Sheet and the Helper Sheet, and why adding the same block of code works but does not in certain areas of the code. I tried adding to end, first, etc. Not working :/ As always, any help is really - greatly appreciated!

[paulked]

I'm sorry, but my time is limited at the mo so this is a 'quick fix'.

You can't write a multi-range eg Range("C5:E9,G9:H16,B14:E18") to an array (I don't think!), therefore you must copy that multi range to an area and then use that area to write to the array.

Try this (my changes are in red):

Sub GetURLs003()
'SPEEDY CODE
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    
    Dim ar As Variant, Meta As String, shMeta As Worksheet, shDest As Worksheet
    Dim i As Long, j As Long, ar1() As Variant, e As Long, lr As Long, tm#
    Dim TempSheet As String
    Dim checkSheetName As String
    tm = Timer
    TempSheet = "URL Temp Sheet"
    'Get source sheet name
    If Len(Range("A6")) < 2 Then
        Meta = GetSh("Please Enter the tab name for your Metadata")
        Range("A6") = Meta
    Else
        Meta = Range("A6").Value
        Result = MsgBox("Would you like to continue to use the worksheet named below?" & vbCrLf & vbCrLf & Meta, vbYesNo + vbQuestion)
            If Result = vbYes Then
                                    Meta = Range("A6")
            Else:
               Meta = GetSh("Please Enter the tab name for your Metadata")
               Range("A6") = Meta
            End If
    End If
    'Check sheet exists
    On Error Resume Next
    Set shMeta = Sheets(Meta)
    On Error GoTo 0
    If shMeta Is Nothing Then MsgBox "That sheet doesn't exist!": Exit Sub
    
'
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
'
    On Error Resume Next
    checkSheetName = Worksheets(TempSheet).Name
    If checkSheetName = "" Then Worksheets.Add.Name = TempSheet
    checkSheetName = ""
    checkSheetName = Worksheets("Helper").CodeName
    If checkSheetName = "" Then
        Worksheets.Add.Name = "Helper"
        Worksheets("Helper").Visible = xlHidden
    End If
    On Error Goto 0
'
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
'
    'Set sheet names
    Set shDest = Sheets(TempSheet)
    'Put source int array
    Sheets("Helper").Cells.ClearContents
    shMeta.UsedRange.SpecialCells(xlCellTypeVisible).Copy
    Sheets("Helper").Range("A1").PasteSpecial xlPasteValues
    ar = Sheets("Helper").UsedRange
    'Loop through data and write to new array ignoring formula errors on data page!
    For i = 2 To UBound(ar, 1)
        For j = LBound(ar, 2) To UBound(ar, 2)
            If LCase(Left(ar(i, j), 10)) = "site page:" Then
                On Error GoTo Nxt
                e = e + 1
                ReDim Preserve ar1(4, e)
                ar1(1, e) = ar(i, j)
                ar1(2, e) = ar(i, j + 1)
            End If
            If LCase(Left(ar(i, j), 8)) = "page url" Then
                On Error GoTo Nxt
                ar1(3, e) = ar(i, j)
                ar1(4, e) = ar(i, j + 1)
            End If
Nxt:
        On Error GoTo -1
        Next
    Next
    On Error GoTo 0
    'Clear destination sheet and write new array
    With shDest
        .Cells.ClearContents
        .Range("A1:E" & UBound(ar1, 2) + 1) = WorksheetFunction.Transpose(ar1)
        'Delete unwanted column
        .Columns("D:D").EntireColumn.Delete
        'Add headers
        .Range("A1") = Format(Now, "m/d/yyyy h:mm:ss AM/PM")
        .Range("B1") = "Page #"
        .Range("C1") = "Page Name"
        .Range("D1") = "Page URL"
        .Range("E1") = "Notes"
        'Delete blank data rows
        'On Error Resume Next
        lr = .Cells(Rows.Count, 2).End(3).Row
        
        
        On Error Resume Next

        ' next line errors if no blank rows!!!

        .Range("D1:D" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0


    End With
    'Add a new sheet and copy new data to it
    With Sheets.Add
        .Name = "URL List " & Format(Now, "HH.MM.ss AM/PM")
        .Tab.Color = vbGreen
        shDest.Range("A1").CurrentRegion.Copy .Range("A1")
        .Columns("A:E").Columns.AutoFit
    End With
    'Sheets("URL List").Activate
   'Delete temp sheet
    Application.DisplayAlerts = False
    Worksheets(TempSheet).Delete
    Application.DisplayAlerts = True


'SPEEDY CODE
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
        'ActiveSheet.DisplayPageBreaks = False
    Application.Calculation = xlCalculationAutomatic
Debug.Print Timer - tm
End Sub

BTW, can you get rid of those functions in Module 1? They add minutes to running a code that normally takes a couple of seconds!