Combining 2 Macro's

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows
I have two macro's-One to import multiple Files and the second macro to delete blank rows on all sheets in Col A

I have incorporated the second macro ("Delete_Rows_apostrophe") with the first macro Open_MultipleFiles, but when doing this the second macro does not delete the apostrophes (Blank cells)

When I run Sub Delete_Rows_apostrophe() epertely , it works perfectly

I cannot determine why it will not work

It would be appreciated if someone could kindly assist me



Code:
 Sub Open_MultipleFiles()
'ChDir "C:\downloads\"

Application.ScreenUpdating = False
Dim LR As Long
Application.DisplayAlerts = False
With Sheets("Sales Data")
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1:C" & LR).ClearContents

End With

With Sheets("report Excluding Zero Values")
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1:C" & LR).ClearContents

End With




Dim fDialog As Object, varFile As Variant
Dim nb As Workbook, tw As Workbook, ts As Worksheet
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .CutCopyMode = False
End With
Set tw = ThisWorkbook
Set ts = tw.ActiveSheet
Set fDialog = Application.FileDialog(3)
'ChDir "C:\downloads"
With fDialog
  .Filters.Clear
  .Filters.Add "Excel files", "*.xlsm*"
   .Show
   
   For Each varFile In .SelectedItems
      Set nb = Workbooks.Open(Filename:=varFile, local:=True)
     
     With Sheets("Sales Data")
   .Range("A1:C1000").Copy
    ThisWorkbook.Sheets("Sales Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormats

    ThisWorkbook.Sheets("Sales Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   
End With
     
      With Sheets("report Excluding Zero Values")
   .Range("A1:C1000").Copy
   ThisWorkbook.Sheets("report Excluding Zero Values").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormats

    ThisWorkbook.Sheets("report Excluding Zero Values").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    
End With
     
     
     
        nb.Close False
   Next
End With
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .CutCopyMode = True
End With
 
 Application.DisplayAlerts = True


Application.ScreenUpdating = True
Delete_Rows_apostrophe
End Sub


Sub Delete_Rows_apostrophe()
Dim I As Long
Dim r As Long
Dim LR As Long
LR = Cells(Rows.Count, "A").End(xlUp).Row

For r = LR To 1 Step -1
For I = 1 To Worksheets.Count
 With Worksheets(I)
If Cells(r, 1) = "" And Not IsEmpty(Cells(r, 1)) Then

.Rows(r).Delete
End If
 End With
  Next I
Next r

 
  
End Sub
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,200
Office Version
  1. 2016
Platform
  1. Windows
Probably you have more than one workbook opened at a time. There is no reference to it or for whatever reason the workbook is not selected after workbook nb was closed.

Try add tw.Activate before Delete_Rows_apostrophe. I presumed that tw is your working workbook.

VBA Code:
Application.ScreenUpdating = True
tw.Activate
Delete_Rows_apostrophe
 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows
Thanks Zot. Tried this but does not work
 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Thanks anyway

I'm sure it is something small that is causing this


I have attached links to these files, which may help in resolving the issue




 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,200
Office Version
  1. 2016
Platform
  1. Windows
Actually which part is not working? I don't seems to understand. I don't see any blank row in between occupied row
 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

When I run the macro "Open_MultipleFiles" which also contains the macro "Delete_Rows_apostrophe" , the rows containing the ' (apostrophe in Col A on Sheet "Sales Data" ,is not being deleted (see rows 104 to 201) When I run macro "Delete_Rows_apostrophe" seperately the rows are being deleted
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,200
Office Version
  1. 2016
Platform
  1. Windows
When I run the macro "Open_MultipleFiles" which also contains the macro "Delete_Rows_apostrophe" , the rows containing the ' (apostrophe in Col A on Sheet "Sales Data" ,is not being deleted (see rows 104 to 201) When I run macro "Delete_Rows_apostrophe" seperately the rows are being deleted
One obvious mistake would be your
LR = Cells(Rows.Count, "A").End(xlUp).Row
is outside the loop. You were looping each sheet but your read LR only once and for month of Oct (for example), it was reading the 2nd sheet (the last sheet data was copied to). So LR = 31
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,200
Office Version
  1. 2016
Platform
  1. Windows
Try like this
VBA Code:
Sub Delete_Rows_apostrophe()
Dim I As Long
Dim r As Long
Dim LR As Long

For I = 1 To Worksheets.Count
    LR = Worksheets(I).Cells(Rows.Count, "A").End(xlUp).Row
    For r = LR To 1 Step -1
    With Worksheets(I)
        If .Cells(r, 1) = "" And Not IsEmpty(.Cells(r, 1)) Then
            .Rows(r).Delete
        End If
    End With
  Next r
Next I

End Sub
 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows
Many thanks for your input and code-its much appreciated

I can now see where I went wrong
 

Watch MrExcel Video

Forum statistics

Threads
1,130,400
Messages
5,641,927
Members
417,247
Latest member
Chitaah

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top