To run a macro on another excel sheet with a different number of rows

waygar 

I cannot explain that.

P.S. This discussion has become very long and awkward to navigate.

If you have a new question unrelated to the current discussion, would you be so kind to start a new discussion? Thanks in advance.

waygar 

In that case, I have no idea why it doesn't work, but you could try

    Set wbkClass = ActiveWorkbook

as in your original code.

waygar 

Are you sure that your workbook is named Classf.xlsx and that it is open in Excel?

waygar 

Yes, that requires a change to the code. Change the line

    Set wbkClass = ThisWorkbook

to

    Set wbkClass = Workbooks("Classf.xlsx")

waygar 

I streamlined the code a bit. It works on the first run for me...

See the attached version (now a macro-enabled workbook).

HansVogelaar 

Hi Hans,
I have produced two small examples.
Load Classf.xlsx and run the macro below.
This will load WAL.xlsx and it is then supposed to copy all data from the sheet "ClassB_List" in Classf.xlsx and paste it at the end of the existing data in the sheet "Allocation List" in WAL.xslx.
However the first execution of the macro seems to load WAL.xlsx but does nothing more until you run the macro again and everything is then okay.
Do you have any ideas what the problem may be?

Sub UpdateLists()
Dim l2Row As Long
Dim BNRows1 As Long

Application.ScreenUpdating = False

Workbooks("Classf.xlsx").Activate
Workbooks("Classf.xlsx").Sheets("ClassB_List").Activate

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

Workbooks.Open "C:\Home\Coding\WAL.xlsx"

Workbooks("WAL.xlsx").Activate
Workbooks("WAL.xlsx").Sheets("Allocation List").Activate

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

Workbooks("Classf.xlsx").Worksheets("ClassB_List").Range("A2", "K" & BNRows1).Copy _
Workbooks("WAL.xlsx").Worksheets("Allocation List").Range("A" & l2Row)

Range("A2").Select
Workbooks("Classf.xlsx").Close SaveChanges:=False

Application.ScreenUpdating = True
End Sub

waygar 

I'd have to se a copy of both workbooks.

HansVogelaar 

Hi Hans,

Any idea why I have to run the macro below twice for it to actually work?

ClassfctnRptNew1482174.xlsx is already open and the macro is run from there to open

Work Allocation List-test.xlsx and copy a block of data from ClassfctnRptNew1482174.xlsx to 

Work Allocation List-test.xlsx

Sub UpdateLists()
Dim l2Row As Long
Dim BNRows1 As Long

Application.ScreenUpdating = False

Workbooks.Open "G:\Classification Workflow\Classification Admin\Work Allocation List-test.xlsx"

Workbooks("Work Allocation List-test.xlsx").Activate
Workbooks("Work Allocation List-test.xlsx").Sheets("Allocation List").Activate

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

Workbooks("ClassfctnRptNew1482174.xlsx").Worksheets("ClassB_List").Range("A2", "K" & BNRows1).Copy _
Workbooks("Work Allocation List-test.xlsx").Worksheets("Allocation List").Range("A" & l2Row)

Range("A2").Select
Workbooks("ClassfctnRptNew1482174.xlsx").Close SaveChanges:=False

Application.ScreenUpdating = True
End Sub

waygar 

Copying, inserting and deleting rows is slow in worksheets with lots of rows, but I agree that this is ridiculous. I put a timer on it, and each copy/insert/delete action took about 2.55 seconds on my PC.

Unfortunately, I don't see how we can speed it up (turning off automatic calculation temporarily had only a marginal effect).

HansVogelaar 

Hi Hans,

I hope you had a good break.

I have attached two links below. Each has a worksheet.

The macro I am using is an adaption of your latest macro sent to me and is attached below. It works but the question is:

Why does it take so long to copy five rows using for example Felixh as the input in one example whereas in the other example it is almost instantaneous. The reason I ask is that in reality the destination sheet can contain thousands of rows and the time taken to copy and insert only a small number of rows from the source sheet to the destination sheet is unrealistic.

The only difference between the two examples is that I have reduced the number of rows in the destination sheet. I have tried to be specific in the ranges in the code but this has made no difference.

Do you have a solution to speeding the code up or what am I doing wrong?

Thank you.

https://urldefense.com/v3/__https:/www.dropbox.com/s/7msm1kkj9o6228u/Work*20Allocation*20List-test.xlsm?dl=0__;JSU!!MiK4Rck!SP58571kS6E1ddOdhS22BVWu5Cl3lssoEt8nW3B0bH4IX2WvefzmvO0S8I9qC38oZISly6dtiVBBLVwJhg0CQDOl$

https://urldefense.com/v3/__https:/www.dropbox.com/s/cykuhksqmktm1f8/Work*20Allocation*20List-test-short.xlsm?dl=0__;JSU!!MiK4Rck!SP58571kS6E1ddOdhS22BVWu5Cl3lssoEt8nW3B0bH4IX2WvefzmvO0S8I9qC38oZISly6dtiVBBLVwJhsiaWvmZ$

The macro is as follows

Sub MoveData_test()
Dim sht1 As Worksheet
Dim sht3 As Worksheet
Set sht1 = Sheets("Seven Day List")
Set sht3 = Sheets("Completed List")
'
Dim strName As String
Dim r As Long
Dim rng As Range
strName = InputBox("Username for Completion Data Transfer?")
If strName = "" Then Exit Sub
Application.ScreenUpdating = False
'
' Transfer completed classified media from Seven Day List (Sheet7) to Completed List (Sheet9).
'
Dim l1Row As Long
Dim l3Row As Long
Dim Count As Long
Dim first As Long
Dim last As Long
Dim rc As Long
'
'
l1Row = sht1.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
l3Row = sht3.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
'
r = 10
first = 2
If l3Row > 101 Then
first = l3Row - 100
End If
last = l3Row + l1Row - r + 1
rc = r
For Count = rc To l1Row
If InStr(1, sht1.Range("J" & r).Value, strName, vbTextCompare) > 0 And (LCase(sht1.Range("K" & r).Value) = "y" Or LCase(sht1.Range("L" & r).Value) = "y") Then
sht1.Range("O" & r).Value = Date
Set rng = sht3.Range("J" & first, "J" & last).Find(What:=strName, LookAt:=xlPart, SearchDirection:=xlPrevious, MatchCase:=False)
If rng Is Nothing Then
Set rng = sht3.Range("J" & first, "J" & last).Find(What:="*", SearchDirection:=xlPrevious)
ElseIf rng.Offset(0, 5).Value <> Date Then
Set rng = sht3.Range("J" & first, "J" & last).Find(What:="*", SearchDirection:=xlPrevious)
End If
sht1.Range("A" & r).EntireRow.Copy
rng.Offset(1).EntireRow.Insert
sht1.Range("A" & r).EntireRow.Delete
r = r - 1
End If
r = r + 1
Next Count
Set rng = sht3.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Application.Goto sht3.Range("A" & rng.Row), True
Application.ScreenUpdating = True
End Sub

waygar 

Happy Holidays and best wishes for 2023 to you too.

waygar 

It's very easy to do this without VBA:

• Select column B.
• On the Data tab of the ribbon, click 'Text to Columns'.
• Click 'Next >' twice.
• In Step 3, select Date, and select YMD from the drop down next to it.
• Click Finish.

As a macro:

Sub Convert2Date()
    Range("B:B").TextToColumns DataType:=xlDelimited, FieldInfo:=Array(1, xlYMDFormat)
End Sub

HansVogelaar 

Perfect now, Thank you so much Hans.

The following request will help me understand a little more about VBA.
Attached is a sample spreadsheet.
Using VBA with Range B:B, how to convert the values in Column B (which are NOT in date format, but a general format) to a date format as follows:
20230205   ---->   5/02/2023
Probably using the formula: B(I)=Date(Left(B(I),4,2),Mid(B(I),5,2),Right(B(I),2))
Thanks.
Cheers,
Wayne

waygar 

Aha - from the way your data were laid out on Sheet3, I thought you wanted to keep rows for the same name together. Try this version:

Sub MoveData()
    Dim strName As String
    Dim r As Long
    Dim rng As Range
    strName = InputBox("Username for Completion Data Transfer?")
    If strName = "" Then Exit Sub
    Application.ScreenUpdating = False
    r = 11
    Do
        If InStr(1, Sheet7.Range("J" & r).Value, strName, vbTextCompare) > 0 And LCase(Sheet7.Range("K" & r).Value) = "y" Then
            Sheet7.Range("O" & r).Value = Date
            Set rng = Sheet9.Range("J:J").Find(What:=strName, LookAt:=xlPart, SearchDirection:=xlPrevious, MatchCase:=False)
            If rng Is Nothing Then
                Set rng = Sheet9.Range("J:J").Find(What:="*", SearchDirection:=xlPrevious)
            ElseIf rng.Offset(0, 5).Value <> Date Then
                Set rng = Sheet9.Range("J:J").Find(What:="*", SearchDirection:=xlPrevious)
            End If
            Sheet7.Range("A" & r).EntireRow.Copy
            rng.Offset(1).EntireRow.Insert
            Sheet7.Range("A" & r).EntireRow.Delete
            r = r - 1
        End If
        r = r + 1
    Loop Until Sheet7.Range("C" & r).Value = ""
    Set rng = Sheet9.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    Application.Goto Sheet9.Range("A" & rng.Row), True
    Application.ScreenUpdating = True
End Sub

waygar 

As far as I can tell the macro already does that, unless you manually change dates in column O to future dates...

HansVogelaar 

Hi Hans,
I have sorted out the error I was getting.
I have attached a sample workbook with your macro (MoveData) included (Hotkey is Ctrl Shft e) again as there is still one issue in the initial request that needs to be actioned:
When a row containing the Name and Date is copied from Sheet1 to Sheet3, that row should be inserted under the last occurrence of that (Same Name and Same Date) in Sheet3. However, if there is not an equivalent Name and associated Date in Sheet3, then the row should be placed beneath the last occupied row in Sheet3.