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