VBA Case Not Recognizing Blank cells

sbpersson

New Member
Joined
May 8, 2018
Messages
8
Good morning all,

So I'm just getting into VBA so I hope you all with cut me some slack in regards to this novice problem. I've written the following code to go through certain worksheets in a workbook, extract a certain range, and paste the data onto a separate sheet titled productivity. Unfortunately, I have no control over how this workbook is laid out (separate worksheets for each day of the month.... drives me crazy). I wrote this last week without a loop and it was very tedious. I'm going to need to write this for multiple functions so I really need this loop to work. My issue is that when it comes across blank cells it doesn't paste zeros into my productivity sheet. It seems to just skip them. This causes the dates not to lign up. Please help!



Code:
Option Explicit
Private Sub InboundProd()
Dim ws As Worksheet
Dim lst As Long
Dim second As Long
 
For Each ws In Worksheets
lst = Sheets("Productivity").Range("B" & Rows.Count).End(xlUp).Row + 1
    
If IsEmpty(Sheets(ws.Name).Range("B2").Value) = True Then
            Sheets("Productivity").Range("B" & lst).Value = 0
End If
        
    Select Case ws.Name
        
        
        Case "Summary", "Productivity"
            'nothing
        Case Sheets(ws.Name).Range("B2").Value = "" Or Sheets(ws.Name).Range("B2").Value = 0
           Sheets("Productivity").Range("B" & lst).Value = 0
         
        Case IsEmpty(Sheets(ws.Name).Range("B2").Value) = False
            Sheets("Productivity").Range("B" & lst).Value = 0
                
        Case Else
                Sheets(ws.Name).Range("B2,D2").Copy
                With Sheets("Productivity")
                                .Range("B" & lst).PasteSpecial xlPasteColumnWidths
                .Range("B" & lst).PasteSpecial xlPasteValues
                End With
                
       End Select
Next
End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,303
Office Version
  1. 365
Platform
  1. Windows
Try
Code:
Private Sub InboundProd()
   Dim ws As Worksheet
   Dim lst As Long
 
   For Each ws In Worksheets
      If ws.Name <> "Summary" And ws.Name <> "Productivity" Then
      lst = Sheets("Productivity").Range("B" & Rows.Count).End(xlUp).Row + 1
       
      If IsEmpty(ws.Range("B2").Value) Then
         Sheets("Productivity").Range("B" & lst).Value = 0
      Else
         ws.Range("B2,D2").Copy
         With Sheets("Productivity")
            .Range("B" & lst).PasteSpecial xlPasteColumnWidths
            .Range("B" & lst).PasteSpecial xlPasteValues
         End With
      End If
   Next ws
End Sub
 

sbpersson

New Member
Joined
May 8, 2018
Messages
8
Thanks for your quick response, however, this code resulted in a compile error = Next without For.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,303
Office Version
  1. 365
Platform
  1. Windows
oops missing an End If
Code:
Private Sub InboundProd()
   Dim ws As Worksheet
   Dim lst As Long
 
   For Each ws In Worksheets
      If ws.Name <> "Summary" And ws.Name <> "Productivity" Then
         lst = Sheets("Productivity").Range("B" & Rows.Count).End(xlUp).Row + 1
   
         If IsEmpty(ws.Range("B2").Value) Then
            Sheets("Productivity").Range("B" & lst).Value = 0
         Else
            ws.Range("B2,D2").Copy
            With Sheets("Productivity")
               .Range("B" & lst).PasteSpecial xlPasteColumnWidths
               .Range("B" & lst).PasteSpecial xlPasteValues
            End With
         End If
      [COLOR=#ff0000]End If[/COLOR]
   Next ws
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,303
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,108,974
Messages
5,525,990
Members
409,673
Latest member
Riseee

This Week's Hot Topics

Top