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: 1482) 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