Nothing happens when sub is executed

StarvingDog

New Member
Joined
May 28, 2019
Messages
8
I'm trying to be more concise with my code so I've attempted to set variables instead of activating sheets as I go. However, it appears as though nothing is happening after I hit execute. The point of this sub is to copy all rows with a blank value in column "O" from two worksheets and paste this information in a separate sheet in a different workbook.

Code:
Sub Transfer_OOS()


    Dim wb1 As Excel.Workbook
    Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\Open OOS.xlsm")
    Dim wb2 As Excel.Workbook
    Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\Logs and Scorecard.xls*", Password:="98skv802kjsdf02")
    
    Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet
    Set sht1 = wb1.Sheets("Open OOS")
    Set sht2 = wb2.Sheets("Chemistry OOS Log")
    Set sht3 = wb2.Sheets("Microbiology OOS Log")
    
    Dim c As Range
    
    Dim Last_Row As Long
    Last_Row = sht1.Range("A250").End(xlUp).Row
              
    For Each c In sht2.Range(("O2:O") & Cells(rows.Count, "O").End(xlUp).Row)
            If Not IsEmpty(c.Value) Then
            Else
                c.EntireRow.Copy
                sht1.Activate
                Cells(Last_Row + 1, 1).PasteSpecial xlValues
                Cells(Last_Row + 1, 1).PasteSpecial xlFormats
            End If
            Last_Row = Last_Row + 1
    Next c


    For Each c In sht3.Range(("O2:O") & Cells(rows.Count, "O").End(xlUp).Row)
            If Not IsEmpty(c.Value) Then
            Else
                c.EntireRow.Copy
                sht1.Activate
                Cells(Last_Row + 1, 1).PasteSpecial xlValues
                Cells(Last_Row + 1, 1).PasteSpecial xlFormats
            End If
            Last_Row = Last_Row + 1
    Next c
    
End Sub
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,402
Office Version
  1. 365
Platform
  1. Windows
Try it like
Code:
   For Each c In Sht2.Range("O2:O" & Sht2.Cells(Rows.Count, "O").End(xlUp).Row)
            If c.Value = "" Then
                c.EntireRow.Copy
                Sht1.Cells(last_row + 1, 1).PasteSpecial xlValues
                Sht1.Cells(last_row + 1, 1).PasteSpecial xlFormats
                last_row = last_row + 1
            End If
    Next c
 

StarvingDog

New Member
Joined
May 28, 2019
Messages
8
Thank you for the response Fluff. I've made your suggested updates but to no avail. After hitting execute sht1 is pulled up and cell "O11" is selected, but nothing has been copied. I'm not receiving any error messages.

Code:
Sub Transfer_OOS()


    Dim wb1 As Excel.Workbook
    Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\Open OOS.xlsm")
    Dim wb2 As Excel.Workbook
    Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\Logs and Scorecard.xls", Password:="98skv802kjsdf02")
    
    Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet
    Set sht1 = wb1.Sheets("Open OOS")
    Set sht2 = wb2.Sheets("Chemistry OOS Log")
    Set sht3 = wb2.Sheets("Microbiology OOS Log")
    
    Dim c As Range
    
    Dim Last_Row As Long
    Last_Row = sht1.Range("A250").End(xlUp).Row
              
    For Each c In sht2.Range("O2:O" & sht2.Cells(rows.Count, "O").End(xlUp).Row)
            If c.Value = "" Then
                c.EntireRow.Copy
                sht1.Cells(Last_Row + 1, 1).PasteSpecial xlValues
                sht1.Cells(Last_Row + 1, 1).PasteSpecial xlFormats
                Last_Row = Last_Row + 1
            End If
    Next c
    
    For Each c In sht3.Range("O2:O" & sht3.Cells(rows.Count, "O").End(xlUp).Row)
            If c.Value = "" Then
                c.EntireRow.Copy
                sht1.Cells(Last_Row + 1, 1).PasteSpecial xlValues
                sht1.Cells(Last_Row + 1, 1).PasteSpecial xlFormats
                Last_Row = Last_Row + 1
            End If
    Next c
    
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,402
Office Version
  1. 365
Platform
  1. Windows
Are you sure that the cells in col O are actually blank & don't contain a space ?
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,935
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Does this work?
Code:
Option Explicit

Sub Transfer_OOS()
Dim wb1 As Excel.Workbook
Dim wb2 As Excel.Workbook
Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet
Dim c As Range
Dim rngDst As Range

    Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\Open OOS.xlsm")

    Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\Logs and Scorecard.xls*", Password:="98skv802kjsdf02")

    Set sht1 = wb1.Sheets("Open OOS")
    Set sht2 = wb2.Sheets("Chemistry OOS Log")
    Set sht3 = wb2.Sheets("Microbiology OOS Log")

    Set rngDst = sht1.Range("A" & Rows.Count).End(xlUp).Offset(1)

    For Each c In sht2.Range("O2:O" & sht2.Cells(Rows.Count, "O").End(xlUp).Row)

        If IsEmpty(c.Value) Then
            c.EntireRow.Copy
            rngDst.PasteSpecial xlValues
            rngDst.PasteSpecial xlFormats
            Set rngDst = rngDst.Offset(1)
        End If

    Next c

    For Each c In sht3.Range("O2:O" & sht3.Cells(Rows.Count, "O").End(xlUp).Row)

        If IsEmpty(c.Value) Then
            c.EntireRow.Copy
            rngDst.PasteSpecial xlValues
            rngDst.PasteSpecial xlFormats
            Set rngDst = rngDst.Offset(1)
        End If

    Next c

End Sub
 

StarvingDog

New Member
Joined
May 28, 2019
Messages
8
Thanks for the replies.

Fluff - I am sure. Previously, this sub was performing this task in a single workbook to a sheet called "Open OOS". For various reasons moving it to a separate workbook will be better. I thought it'd be easy to plug in the initial code and make a few adjustments, but apparently that's not the case.

Norie - Nope same thing as before.
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,935
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

If you step through the code with F8 are the lines that copy ever executed?

Have you checked where the last value in column A in the destination sheet?
 

StarvingDog

New Member
Joined
May 28, 2019
Messages
8
First off, I did not know about F8... that's a huge help. Thank you. Second, I was unaware that set wb1 = Workbooks.Open(....) actually opens that workbook at that line of code. I've set wb1 to open the book that contains the code so it seems like when it gets to that line it reopens the book and restarts the sub. To clarify, when this workbook ("Open OOS") is opened I'd like it to copy data from two worksheets ("Chemistry OOS Log" and "Microbiology OOS Log") in another password protected workbook ("Logs and Scorecard") and paste it in this workbooks ("Open OOS") only worksheet ("Open OOS").
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,935
Office Version
  1. 365
Platform
  1. Windows
If you want this code to run when a workbook is opened then you should put the code, or a call to it, in that workbook's Workbook_Open event, which you'll find in the ThisWorkbook module.

If you need to refer to the workbook the code is running from in the code then you can use ThisWorkbook.
 

StarvingDog

New Member
Joined
May 28, 2019
Messages
8
That was the issue... switched wb1 = ThisWorkbook and it works. Thank you both for your help!
 

Watch MrExcel Video

Forum statistics

Threads
1,114,471
Messages
5,548,218
Members
410,824
Latest member
Bobmn4
Top