Fixing VBA Code

helplessnoobatexcel

New Member
Joined
Dec 15, 2023
Messages
45
Office Version
  1. 365
Platform
  1. Windows
Hi guys, I have this VBA code which is meant to check if any changes has been made to the selected sheets that are currently linked to the master sheet and if yes, it would automatically update the master sheet. It also consolidates the selected sheets into a master sheet and removes rows of blanks in the master sheet. (if any) . However, this code gives me multiple errors when I run it. Any kind soul willing to help me run this code on a workbook and give me some pointers on what I can change? It would be greatly appreciated!! I have been stuck on this for nearly 5 days already ;-;.
Dim selectedSheets As Sheets
Dim masterSheet As Worksheet

Private Sub Worksheet_Change(ByVal Target As Range)
'Check if the change occured in one of the selected sheets'
If Not Intersect(Target.Worksheet, selectedSheets) Is Nothing Then
'Call the consolidation function when changes are detected'
ConsolidateAndRemoveBlanks
End If

End Sub

Sub ConsolidateAndRemoveBlanks()
Dim ws As Worksheet
Dim lastRow As Long, i As Long, j As Long
'Check if the master sheet exists, if not, create it'
On Error Resume Next
Set masterSheet = Worksheets("MasterSheet")
On Error GoTo 0
If masterSheet Is Nothing Then
Set masterSheet = Sheets.Add(After:=Sheets(Sheets.Count))
masterSheet.Name = "MasterSheet"
Else
'Clear existing data on the master sheet'
masterSheet.Cells.Clear
End If
'Loop through selected sheets and consolidate data'
For Each ws In ActiveWindow.selectedSheets
'Copy data to master sheet'
ws.UsedRange.Copy masterSheet.Cells(masterSheet.Rows.Count, 1).End(x1Up).Offset(1, 0)
Next ws
'Remove blank rows from the master sheet'
lastRow = masterSheet.Cells(masterSheet.Rows.Count, 1).End(x1Up).Row
For i = lastRow To 1 Step -1
For j = 1 To masterSheet.Columns.Count
If IsEmpty(masterSheet.Cells(i, j)) Then
masterSheet.Rows(i).Delete
Exit For
End If
Next j
Next i

End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Hi,

For starters, Intersect function only works with ranges. You have to loop through the worksheets to check with the target worksheet name. If you are receiving any other error, you must mention in which line you got the error and what the error says.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  For Each ws In ActiveWindow.SelectedSheets
    If ws.Name = Target.Worksheet.Name Then
      Call ConsolidateAndRemoveBlanks
    End If
  Next
End Sub
 
Upvote 0
Hi,

For starters, Intersect function only works with ranges. You have to loop through the worksheets to check with the target worksheet name. If you are receiving any other error, you must mention in which line you got the error and what the error says.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  For Each ws In ActiveWindow.SelectedSheets
    If ws.Name = Target.Worksheet.Name Then
      Call ConsolidateAndRemoveBlanks
    End If
  Next
End Sub
Hi Flashbond, ahh I see. That makes sense, I've modified the code.
The current error I have is run-time error '1004' (Application-defined or object-defined error) and the current line of code is:
ws.UsedRange.Copy masterSheet.Cells(masterSheet.Rows.Count, 1).End(x1Up).Offset(1, 0)
 
Upvote 0
This should be with lowercase letter L. Not number 1.
End(xlUp)
Thanks for pointing that out! 🫡I've corrected my error and the code now runs smoothly however it does not display anything on the newly created MasterSheet and it is blank..
 
Upvote 0
I don't know. That worked perfectly fine for me. I only changed this line:
VBA Code:
If masterSheet Is Nothing Then
to this:
VBA Code:
If IsEmpty(masterSheet) Then
1703155383301.png
 
Upvote 0
I don't know. That worked perfectly fine for me. I only changed this line:
VBA Code:
If masterSheet Is Nothing Then
to this:
VBA Code:
If IsEmpty(masterSheet) Then
View attachment 103899
May I ask, if you used my full code? From the looks of it it seems as though you only used a part of my code..I changed that line of code and reran it but nothing registers on the mastersheet still..
 
Upvote 0
I don't know what the copied data look like.
Maybe you have empty cells, so all your cells have being deleted. Try WITHOUT the part below:
VBA Code:
lastRow = masterSheet.Cells(masterSheet.Rows.Count, 1).End(x1Up).Row
For i = lastRow To 1 Step -1
For j = 1 To masterSheet.Columns.Count
If IsEmpty(masterSheet.Cells(i, j)) Then
masterSheet.Rows(i).Delete
Exit For
End If
Next j
Next i
Do you see any data in the masterSheet?
 
Upvote 0
Solution
Or,
Can you modify this part and try again:
VBA Code:
For j = 1 To masterSheet.UsedRange.Columns.Count
 
Upvote 0
I don't know what the copied data look like.
Maybe you have empty cells, so all your cells have being deleted. Try WITHOUT the part below:
VBA Code:
lastRow = masterSheet.Cells(masterSheet.Rows.Count, 1).End(x1Up).Row
For i = lastRow To 1 Step -1
For j = 1 To masterSheet.Columns.Count
If IsEmpty(masterSheet.Cells(i, j)) Then
masterSheet.Rows(i).Delete
Exit For
End If
Next j
Next i
Do you see any data in the masterSheet?
Hi Flashbond,
Sorry for the late reply, I was on leave for Christmas.
Yep! I do now, the code finally works now! Any idea if you know how to remove the blanks in consolidated data and repeated headers?
 
Upvote 0

Forum statistics

Threads
1,215,069
Messages
6,122,954
Members
449,095
Latest member
nmaske

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