Select rows with data including blank rows VBA

U

urubag

New Member
Joined
Aug 17, 2021
Messages
20
Office Version
  1. 365
Platform
  1. Windows
Hi Guys,

I have reviewing many blogs and websites to see if there is a way to select the data inlcuding if users leave blank rows in the middle of them.
My code is not taking the rest of the rows with data since one row is empty.

Example:

From row 1 to row 3 have data, row 4 is empty and row 5 has data, so anyone can help me to change my code to include the row 5 in a dinamic way, that means the code can select the last row with data no matter if there are empty rows in the middle.

VBA Code: 
'Option Private Module

Sub Extraction()

With Application

.ScreenUpdating = False
.DisplayAlerts = False
.AskToUpdateLinks = False
.EnableEvents = False

Dim MasterOne As Workbook
Set MasterOne = ThisWorkbook

'On Error Resume Next

' Andres template

Workbooks.Open Filename:="L:\2022 Hierarchy Changes\Consolidation\Hierarchy templates\Andres\Hierarchy_Template.xlsm"

    Workbooks("Hierarchy_Template.xlsm").Activate

        'CIM MApping Rule
        
        Sheets("CIM Mapping Rule").Select
        
        Range("A2:AV2", Range("A2:AV2").End(xlDown)).Select
        Selection.Copy
            
        MasterOne.Activate
        
        Sheets("CIM Mapping Rule2").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAllUsingSourceTheme)
        
        
        'GL Mapping Org Map
        
        Workbooks("Hierarchy_Template.xlsm").Activate
        
        Sheets("GL Mapping Org Map").Select
        
        Range("A2:AV2", Range("A2:AV2").End(xlDown)).Select
        Selection.Copy
            
        MasterOne.Activate
        
        Sheets("GL Mapping Org Map2").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAllUsingSourceTheme)
        
        'GL Mapping Org Map
        
        Workbooks("Hierarchy_Template.xlsm").Activate
        
        Sheets("GL Mapping Org Map").Select
        
        Range("A2:AV2", Range("A2:AV2").End(xlDown)).Select
        Selection.Copy
            
        MasterOne.Activate
        
        Sheets("GL Mapping Org Map2").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAllUsingSourceTheme)
        
        'GL Mapping Product Map
        
        Workbooks("Hierarchy_Template.xlsm").Activate
        
        Sheets("GL Mapping Product Map").Select
        
       Range("A2:AV2", Range("A2:AV2").End(xlDown)).Select
        Selection.Copy
            
        MasterOne.Activate
        
        Sheets("GL Mapping Product Map2").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAllUsingSourceTheme)
        
        Workbooks("Hierarchy_Template.xlsm").Close savechanges:=False

.ScreenUpdating = True
.DisplayAlerts = True
.AskToUpdateLinks = True

End With

End Sub

Appreciate your help
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
Try replacing everywhere you have these 2 line:
VBA Code: 
    Range("A2:AV2", Range("A2:AV2").End(xlDown)).Select
    Selection.Copy

With this line
VBA Code: 
Range(Cells(2, "A"), Cells(Cells(Rows.Count, "A").End(xlUp).Row, "AV")).Copy

xlDown will stop the cell before the first empty cell in the down direction.
the xlUp statement starts at the very bottom of the sheet and finds the last non-empty cell in the specified column which in the above is "A".
 
Upvote 0
Hi @Alex Blakenburg ,

Thanks for the response,

Please note works good when the file has data, but unfortunately in all sheets needs to consolidate the information they have headers, so I dont want the headers to extract when the sheets dont have data from row 2, so how should be the code keeping mind that?

Regards
 
Upvote 0
Try: (UNTESTED)
VBA Code: 
Sub Extraction()
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .AskToUpdateLinks = False
        .EnableEvents = False
    End With
    Dim MasterOne As Workbook, CIM As Worksheet, CIM2 As Worksheet, GL As Worksheet, GL2 As Worksheet, GLPM As Worksheet, GLPM2 As Worksheet
    Set MasterOne = ThisWorkbook
    Set CIM = Workbooks("Hierarchy_Template.xlsm").Sheets("CIM Mapping Rule")
    Set CIM2 = MasterOne.Sheets("CIM Mapping Rule2")
    Set GL = Workbooks("Hierarchy_Template.xlsm").Sheets("GL Mapping Org Map")
    Set GL2 = MasterOne.Sheets("GL Mapping Org Map2")
    Set GLPM = Workbooks("Hierarchy_Template.xlsm").Sheets("GL Mapping Product Map")
    Set GLPM2 = MasterOne.Sheets("GL Mapping Product Map2")
    CIM.Range("A2", CIM.Range("AV" & Rows.Count).End(xlUp)).Copy CIM2.Cells(CIM2.Rows.Count, "A").End(xlUp).Offset(1)
    GL.Range("A2", GL.Range("AV" & Rows.Count).End(xlUp)).Copy GL2.Cells(GL2.Rows.Count, "A").End(xlUp).Offset(1)
    GLPM.Range("A2", GLPM.Range("AV" & Rows.Count).End(xlUp)).Copy GLPM2.Cells(GLPM2.Rows.Count, "A").End(xlUp).Offset(1)
    Workbooks("Hierarchy_Template.xlsm").Close savechanges:=False
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .AskToUpdateLinks = True
        .EnableEvents = True
    End With
End Sub
 
Upvote 0
urubag said:
I dont want the headers to extract when the sheets dont have data from row 2, so how should be the code keeping mind that?
Click to expand...
@mumps's code will have this issue as well.

Try the below.
PS: Your original code seems to copy the GL Mapping Org Map twice, we are assuming that is an error.
The could be converted to using a loop, even easier if the naming convention of just adding "2" to the sheet name can be relied on.

VBA Code: 
Sub Extraction_OP_Cleanup()

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .AskToUpdateLinks = False
        .EnableEvents = False
    End With
   
    Dim wbMasterOne As Workbook
    Set wbMasterOne = ThisWorkbook
   
    ' Andres template
    Dim wbHierachy As Workbook
    Workbooks.Open Filename:="L:\2022 Hierarchy Changes\Consolidation\Hierarchy templates\Andres\Hierarchy_Template.xlsm"
    Set wbHierachy = ActiveWorkbook
   
    'Copy sheets
    Dim rowLast As Long
    Dim shtHier As Worksheet
    Dim shtMstr As Worksheet
   
    'CIM MApping Rule
    Set shtHier = wbHierachy.Sheets("CIM Mapping Rule")
    Set shtMstr = wbMasterOne.Sheets("CIM Mapping Rule2")
   
    rowLast = shtHier.Range("A" & shtHier.Rows.Count).End(xlUp).Row
    If rowLast >= 2 Then
        shtHier.Range("A2:AV" & rowLast).Copy
   
        With shtMstr
            rowLast = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A" & rowLast).Offset(1).PasteSpecial (xlPasteAllUsingSourceTheme)
        End With
    End If
           
    'GL Mapping Org Map
    Set shtHier = wbHierachy.Sheets("GL Mapping Org Map")
    Set shtMstr = wbMasterOne.Sheets("GL Mapping Org Map2")
   
    rowLast = shtHier.Range("A" & shtHier.Rows.Count).End(xlUp).Row
    If rowLast >= 2 Then
        shtHier.Range("A2:AV" & rowLast).Copy
   
        With shtMstr
            rowLast = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A" & rowLast).Offset(1).PasteSpecial (xlPasteAllUsingSourceTheme)
        End With
    End If

    'GL Mapping Product Map
    Set shtHier = wbHierachy.Sheets("GL Mapping Product Map")
    Set shtMstr = wbMasterOne.Sheets("GL Mapping Product Map2")
   
    rowLast = shtHier.Range("A" & shtHier.Rows.Count).End(xlUp).Row
    If rowLast >= 2 Then
        shtHier.Range("A2:AV" & rowLast).Copy
   
        With shtMstr
            rowLast = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A" & rowLast).Offset(1).PasteSpecial (xlPasteAllUsingSourceTheme)
        End With
    End If
           
    wbHierachy.Close savechanges:=False
   
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .AskToUpdateLinks = True
    End With

End Sub
 
Upvote 0
Solution
Alex Blakenburg said:
@mumps's code will have this issue as well.

Try the below.
PS: Your original code seems to copy the GL Mapping Org Map twice, we are assuming that is an error.
The could be converted to using a loop, even easier if the naming convention of just adding "2" to the sheet name can be relied on.

VBA Code: 
Sub Extraction_OP_Cleanup()

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .AskToUpdateLinks = False
        .EnableEvents = False
    End With
  
    Dim wbMasterOne As Workbook
    Set wbMasterOne = ThisWorkbook
  
    ' Andres template
    Dim wbHierachy As Workbook
    Workbooks.Open Filename:="L:\2022 Hierarchy Changes\Consolidation\Hierarchy templates\Andres\Hierarchy_Template.xlsm"
    Set wbHierachy = ActiveWorkbook
  
    'Copy sheets
    Dim rowLast As Long
    Dim shtHier As Worksheet
    Dim shtMstr As Worksheet
  
    'CIM MApping Rule
    Set shtHier = wbHierachy.Sheets("CIM Mapping Rule")
    Set shtMstr = wbMasterOne.Sheets("CIM Mapping Rule2")
  
    rowLast = shtHier.Range("A" & shtHier.Rows.Count).End(xlUp).Row
    If rowLast >= 2 Then
        shtHier.Range("A2:AV" & rowLast).Copy
  
        With shtMstr
            rowLast = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A" & rowLast).Offset(1).PasteSpecial (xlPasteAllUsingSourceTheme)
        End With
    End If
          
    'GL Mapping Org Map
    Set shtHier = wbHierachy.Sheets("GL Mapping Org Map")
    Set shtMstr = wbMasterOne.Sheets("GL Mapping Org Map2")
  
    rowLast = shtHier.Range("A" & shtHier.Rows.Count).End(xlUp).Row
    If rowLast >= 2 Then
        shtHier.Range("A2:AV" & rowLast).Copy
  
        With shtMstr
            rowLast = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A" & rowLast).Offset(1).PasteSpecial (xlPasteAllUsingSourceTheme)
        End With
    End If

    'GL Mapping Product Map
    Set shtHier = wbHierachy.Sheets("GL Mapping Product Map")
    Set shtMstr = wbMasterOne.Sheets("GL Mapping Product Map2")
  
    rowLast = shtHier.Range("A" & shtHier.Rows.Count).End(xlUp).Row
    If rowLast >= 2 Then
        shtHier.Range("A2:AV" & rowLast).Copy
  
        With shtMstr
            rowLast = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A" & rowLast).Offset(1).PasteSpecial (xlPasteAllUsingSourceTheme)
        End With
    End If
          
    wbHierachy.Close savechanges:=False
  
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .AskToUpdateLinks = True
    End With

End Sub
Click to expand...

Yes, Great works as expected, thank you so much


Regards
Andres
 
Upvote 0
Maybe:
VBA Code: 
Sub Extraction()
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .AskToUpdateLinks = False
        .EnableEvents = False
    End With
    Dim MasterOne As Workbook, CIM As Worksheet, CIM2 As Worksheet, GL As Worksheet, GL2 As Worksheet, GLPM As Worksheet, GLPM2 As Worksheet
    Set MasterOne = ThisWorkbook
    Set CIM = Workbooks("Hierarchy_Template.xlsm").Sheets("CIM Mapping Rule")
    Set CIM2 = MasterOne.Sheets("CIM Mapping Rule2")
    Set GL = Workbooks("Hierarchy_Template.xlsm").Sheets("GL Mapping Org Map")
    Set GL2 = MasterOne.Sheets("GL Mapping Org Map2")
    Set GLPM = Workbooks("Hierarchy_Template.xlsm").Sheets("GL Mapping Product Map")
    Set GLPM2 = MasterOne.Sheets("GL Mapping Product Map2")
    If CIM.Range("A2") <> "" Then
        CIM.Range("A2", CIM.Range("AV" & Rows.Count).End(xlUp)).Copy CIM2.Cells(CIM2.Rows.Count, "A").End(xlUp).Offset(1)
    End If
    If GL.Range("A2") <> "" Then
        GL.Range("A2", GL.Range("AV" & Rows.Count).End(xlUp)).Copy GL2.Cells(GL2.Rows.Count, "A").End(xlUp).Offset(1)
    End If
    If GLPM.Range("A2") <> "" Then
        GLPM.Range("A2", GLPM.Range("AV" & Rows.Count).End(xlUp)).Copy GLPM2.Cells(GLPM2.Rows.Count, "A").End(xlUp).Offset(1)
    End If
    Workbooks("Hierarchy_Template.xlsm").Close savechanges:=False
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .AskToUpdateLinks = True
        .EnableEvents = True
    End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
441
CapRavOr
C
C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
182
NdNoviceHlp
NdNoviceHlp
H
  • Solved
Macro to speedy up process when copying Data
Replies
3
Views
75
Logit
Logit
C
  • Question Question
How to automatically paste the data from one sheet to another using VBA
Replies
4
Views
235
Alex Blakenburg
A
D
  • Solved
VBA If statement to continue
2
Replies
17
Views
604
dinunan
D

Forum statistics

Threads
1,223,888
Messages
6,175,219
Members
452,619
Latest member
Shiv1198

Share this page

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
Back
Top