Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Cannot skip blank cell that with Formula

0

Hi All,  currently i am using this code for consolidate the multiple worksheet. However, i am having a problem whereby i cannot skip the blank cell that with formula. Appreciate your help on the following:

Public Sub consolWS()
    Dim dataShtNm As String  'the sheet name of source data
    Dim consolShtNm As String
    Dim consolLastRow, loopedShtLastRow, loopedShtLastCol As String
    Dim msgboxRslt As Integer
    consolShtNm = InputBox("Enter the worksheet name that you want to conlidate data in")
    If consolShtNm = "" Then
        msgboxRsltDummy = MsgBox("Action cancel", vbInformation)
        Exit Sub
    Else
        dataShtNm = InputBox("Enter wildcard conditions for worksheet name that you want to consolidate data from" & vbCrLf & vbCrLf & "For example, type data* to combine all worksheet with name starts with data" & vbCrLf & vbCrLf & "Type * to conslidate all worksheets except the consol sheet iteslf")
        If dataShtNm = "" Then
            msgboxRsltDummy = MsgBox("Action cancel", vbInformation)
            Exit Sub
        Else
            If WorksheetExists(consolShtNm) = False Then  'worksheet does not exist
                msgboxRslt1 = MsgBox("Worksheet '" & consolShtNm & "' not found, a new worksheet will be created now", vbOKCancel + vbExclamation)
                If msgboxRslt1 = 1 Then  'user confirm to create new worksheet
                    Sheets.Add().Name = consolShtNm
                    For Each sht In ActiveWorkbook.Worksheets
                        If sht.Name <> consolShtNm And sht.Name Like dataShtNm Then
                            consolLastRow = colLastRow(consolShtNm, "B")   'check the last row in consol sheet
                            loopedShtLastRow = colLastRow(sht.Name, "B") 'check the last row in current looped sheet
                            loopedShtLastCol = rowLastColNm(sht.Name, 1) 'check the last column in current looped sheet
                            Sheets(sht.Name).Range("B3", loopedShtLastCol & loopedShtLastRow).Copy  'copy all data in looped sheet
                            Sheets(consolShtNm).Activate
                            Sheets(consolShtNm).Range("B" & consolLastRow + 1).Select
                            Selection.PasteSpecial Paste:=xlPasteValues
                            For i = consolLastRow + 1 To consolLastRow + loopedShtLastRow - 1
                            ActiveSheet.Range("A" & i).Value = sht.Name
                            Next i
                        End If
                    Next sht
                Else 'user cancel create new worksheet
                    msgboxRsltDummy = MsgBox("Action cancel", vbInformation)
                    Exit Sub
                End If
            Else  'consolidation worksheet already exists
                msgboxRslt2 = MsgBox("Worksheet '" & consolShtNm & "' already exists, new data will be appended beginning from the last record", vbOKCancel + vbExclamation)
                If msgboxRslt2 = 2 Then   'user cancel append data to last record of desired worksheet
                    dummy = MsgBox("Action cancel", vbInformation)
                Else
                    For Each sht In ActiveWorkbook.Worksheets
                        If sht.Name <> consolShtNm And sht.Name Like dataShtNm Then
                            consolLastRow = colLastRow(consolShtNm, "B")   'check the last row in consol sheet
                            loopedShtLastRow = colLastRow(sht.Name, "B") 'check the last row in current looped sheet
                            loopedShtLastCol = rowLastColNm(sht.Name, 1) 'check the last column in current looped sheet
                            Sheets(sht.Name).Range("B3", loopedShtLastCol & loopedShtLastRow).Copy  'copy all data in looped sheet
                            Sheets(consolShtNm).Activate
                            Sheets(consolShtNm).Range("B" & consolLastRow + 1).Select
                            Selection.PasteSpecial Paste:=xlPasteValues
                            For i = consolLastRow + 1 To consolLastRow + loopedShtLastRow - 1
                            ActiveSheet.Range("A" & i).Value = sht.Name
                            Next i
                        End If
                    Next sht
                End If
            End If
        End If
    End If
End Sub
Public Function colLastRow(worksheetNm As String, colNm As String) As Integer
    colLastRow = Worksheets(worksheetNm).Range(colNm & Rows.Count).End(xlUp).Row
End Function
Public Function rowLastColNum(worksheetNm As String, rowNum) As Integer
    rowLastColNum = Worksheets(worksheetNm).Range("IV" & rowNum).End(xlToLeft).Column
End Function
Public Function rowLastColNm(worksheetNm As String, rowNum) As String
    Dim rowLastColNum As Integer
    rowLastColNum = Worksheets(worksheetNm).Range("IV" & rowNum).End(xlToLeft).Column
    rowLastColNm = Split(Cells(1, rowLastColNum).Address, "$")(1)
End Function
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    On Error Resume Next
    WorksheetExists = (Sheets(WorksheetName).Name <> "")
    On Error GoTo 0
End Function
Post Edited
CODE Tags: You must add [CODE][/CODE] tags around your code! (click the CODE button to do this when creating a post)
Answer
Discuss

Discussion

Do you mean that you want to skip copying over blank or empty cells? If so, just remove them after the copy.
don (rep: 1989) Oct 26, '17 at 3:16 am
Ya, i know but thinking if there is a way to automate remove the blank cells to copy over.The loop can only detect the "Blank cells" but not the "blank cells with formula" or "no value cells"
Currently, i need to manually remove them by filter and remove blank.
Edward_13 (rep: 2) Oct 26, '17 at 5:02 am
Add to Discussion

Answers

0
Application.CountA(ActiveCell)
will return zero if the cell is blank or 1 if the cell contains a formula or a value, even if the formula evaluates to "". "ActiveCell" stands for a range. You might replace it with something like "Range(Cells(1, 1), Cells(10, 10))". COUNTA will return the number of non-blank cells in the range.
Discuss


Answer the Question

You must create an account to use the forum. Create an Account or Login