VB Code to work in background

[ateebali]

Currently I am using a lengthy vb code but when Its playing, we can see all things on screen, can someone help to shorten it where it can performs things in background?

Sub New_TCS()
Range("O6").Value = Range("O6").Value + 1


For sh = 1 To Sheets.Count
        Sheets(sh).Visible = -1
    Next sh




'
' Macro1 Macro
'


'
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
'Modified 12/29/2018 2:34:32 AM  EST
Application.ScreenUpdating = False
Dim i As Long
For i = 6 To 250 Step 4
Cells(i, 2).Resize(, 16).ClearContents
Next
Range("B9:B250").Select
Range("B250").Activate
Selection.EntireRow.Hidden = True
Range("B6").Select


Application.ScreenUpdating = True
    
    
    
    
ActiveSheet.Previous.Select
    Range("C11:C27").Select
    Selection.ClearContents
    Range("B10").Select
    
    ActiveSheet.Previous.Select
    'Updateby Extendoffice 20161129
    Dim chkBox As Excel.CheckBox
    Application.ScreenUpdating = False
    For Each chkBox In ActiveSheet.CheckBoxes
            chkBox.Value = xlOff
    Next chkBox
    Application.ScreenUpdating = True
    
    ActiveSheet.Previous.Select
    For Each Pic In ActiveSheet.Pictures
        If Not Intersect(Pic.TopLeftCell, Range("B4:D20")) Is Nothing Then
            Pic.Delete
        End If
    Next Pic
            
    ActiveSheet.Previous.Select
    Range("C5:D32").Select
    Selection.ClearContents
    Range("F12:G13").Select
    Selection.ClearContents
    Range("I6:J7").Select
    Selection.ClearContents
    Range("F6:G7").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=0
    Range("D9").Select
    
    ActiveSheet.Previous.Select
    Range("J9:L10").Select
    Selection.ClearContents
    Range("J13:L14").Select
    Selection.ClearContents
    Range("F14:H15").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=3
    Range("F18:H19").Select
    Selection.ClearContents
    Range("K17").Select
    ActiveWindow.SmallScroll Down:=-6
    
    ActiveSheet.Previous.Select
    '
    Sheets(Array("New Style", "Garment Detail", "Picture", "Operations", _
        "Machines Data", "Layout", "Report", "Summary", "Short")).Select
    Sheets("Short").Activate
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Consolidated Report").Select
    ActiveWindow.SelectedSheets.Visible = False
    Range("F8").Select


End Sub

 

[Zack Barresse]

Hi there,

You cannot do what you're asking. VBA doesn't work asynchronously.

On another note, I would highly recommend re-working your code. I see most of it is from the macro recorder - which is a fine starting point but not very efficient. It could be re-worked here but there would be a lot of assumptions as to what sheets are being worked on with the amount of selections and activations going on, so you'd need to define exactly what sheet it's working on throughout (most of it anyway, some could be inferred).

 

[ateebali]

Dear Sir, Yes it is recorded, I am explaining below my purpose;

Button exist on sheet name "Summary" when we click it;
1. It change the value of Cell O6 of same sheet with +1

Range("O6").Value = Range("O6").Value + 1

The workbook have all hidden worksheets with VB code, so now need to unhide worksheets with following code;

For sh = 1 To Sheets.Count
Sheets(sh).Visible = -1
Next sh




'

Now when all sheets are available, we need to perform different task on different sheets, for example;
Previous sheet to summary is "Report" no work here, then previous is "Layout", need to apply following code here;

Application.ScreenUpdating = False
Dim i As Long
For i = 6 To 250 Step 4
Cells(i, 2).Resize(, 16).ClearContents
Next
Range("B9:B250").Select
Range("B250").Activate
Selection.EntireRow.Hidden = True
Range("B6").Select


Application.ScreenUpdating = True

Now Previous sheet "Machine Data" following code should work here

Range("C11:C27").Select
Selection.ClearContents

Previous Sheet is now "Operations", following code should work here;

Dim chkBox As Excel.CheckBox
Application.ScreenUpdating = False
For Each chkBox In ActiveSheet.CheckBoxes
chkBox.Value = xlOff
Next chkBox
Application.ScreenUpdating = True

Now previous sheet is "Picture", it has to run following code;

For Each Pic In ActiveSheet.Pictures
If Not Intersect(Pic.TopLeftCell, Range("B4:D20")) Is Nothing Then
Pic.Delete
End If
Next Pic

Now previous sheet is "Garment Detail" this code should work here;

Range("C5:D32").Select
Selection.ClearContents
Range("F12:G13").Select
Selection.ClearContents
Range("I6:J7").Select
Selection.ClearContents
Range("F6:G7").Select
Selection.ClearContents

Now Previous sheet is "New Style", it has following code;

Range("J9:L10").Select
Selection.ClearContents
Range("J13:L14").Select
Selection.ClearContents
Range("F14:H15").Select
Selection.ClearContents
Range("F18:H19").Select
Selection.ClearContents

Now Previous Sheet is "Welcome" so all other sheets should be hidden now except "Welcome"

Sheets(Array("New Style", "Garment Detail", "Picture", "Operations", _ "Machines Data", "Layout", "Report", "Summary", "Short")).Select
Sheets("Short").Activate
ActiveWindow.SelectedSheets.Visible = False
Sheets("Consolidated Report").Select
ActiveWindow.SelectedSheets.Visible = False

 

[Zack Barresse]

There's really no need to select anything and you should explicitly reference the worksheets. Maybe see if this works:

Sub New_TCS()

    Dim OpsCheckBox As Excel.CheckBox
    Dim Sheet As Worksheet
    Dim Index As Long
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook.Worksheets("Summary")
        .Range("O6").Value = .Range("O6").Value + 1
    End With
        
    With ThisWorkbook.Worksheets("Layout")
        For Index = 6 To 250 Step 4
            .Cells(Index, 2).Resize(, 16).ClearContents
        Next
        .Range("B9:B250").EntireRow.Hidden = True
    End With
        
    With ThisWorkbook.Worksheets("Machine Data")
        .Range("C11:C27").ClearContents
    End With
    
    With ThisWorkbook.Worksheets("Operations")
        For Each OpsCheckBox In .CheckBoxes
            OpsCheckBox.Value = xlOff
        Next OpsCheckBox
    End With
    
    With ThisWorkbook.Worksheets("Picture")
        For Each Pic In .Pictures
            If Not Intersect(Pic.TopLeftCell, .Range("B4:D20")) Is Nothing Then
                Pic.Delete
            End If
        Next Pic
    End With
    
    With ThisWorkbook.Worksheets("Garment Detail")
        .Range("C5:D32").ClearContents
        .Range("F12:G13").ClearContents
        .Range("I6:J7").ClearContents
        .Range("F6:G7").ClearContents
    End With
    
    With ThisWorkbook.Worksheets("New Style")
        .Range("J9:L10").ClearContents
        .Range("J13:L14").ClearContents
        .Range("F14:H15").ClearContents
        .Range("F18:H19").ClearContents
    End With

    ThisWorkbook.Worksheets("Welcome").Activate
    For Each Sheet In ThisWorkbook.Worksheets
        If Sheet.Name <> "Welcome" And Sheet.Visible <> xlSheetHidden Then
            Sheet.Visible = xlSheetHidden
        End If
    Next Sheet
    
    Application.ScreenUpdating = True
    
End Sub

 

[ateebali]

Sir I think this working fine, just one issue as below;

Run-time error '1004':
Method 'Visible' of object'_Worksheet'failed

When click on debug
this highlights with yellow

Sheet.Visible = xlSheetHidden

 

[Zack Barresse]

Is the workbook protected? That may prevent you from hiding worksheets. I'd probably also move the ScreenUpdating = True line to above the sheet loop, so the 'Welcome' sheet actually gets activated.

 

[ateebali]

All unprotect sheets, the code worked when I unhide all sheets with below code;
For sh = 1 To Sheets.Count
Sheets(sh).Visible = -1
Next sh




'

 

[Zack Barresse]

It shouldn't have got to that line of code if the sheet was hidden. To test you can step through your code. You're looking for this line: If Sheet.Name <> "Welcome" And Sheet.Visible <> xlSheetHidden Then. Check the sheet visibility if the next line produces an error.

 

[ateebali]

Dear Sir
Thanks, this code work well;

Sub New_TCS()For sh = 1 To Sheets.Count
Sheets(sh).Visible = -1
Next sh
Dim OpsCheckBox As Excel.CheckBox
Dim Sheet As Worksheet
Dim Index As Long

Application.ScreenUpdating = False

With ThisWorkbook.Worksheets("Summary")
.Range("O6").Value = .Range("O6").Value + 1
End With

With ThisWorkbook.Worksheets("Layout")
For Index = 6 To 250 Step 4
.Cells(Index, 2).Resize(, 16).ClearContents
Next
.Range("B9:B250").EntireRow.Hidden = True
End With

With ThisWorkbook.Worksheets("Machines Data")
.Range("C11:C27").ClearContents
End With

With ThisWorkbook.Worksheets("Operations")
For Each OpsCheckBox In .CheckBoxes
OpsCheckBox.Value = xlOff
Next OpsCheckBox
End With

With ThisWorkbook.Worksheets("Picture")
For Each Pic In .Pictures
If Not Intersect(Pic.TopLeftCell, .Range("B4:D20")) Is Nothing Then
Pic.Delete
End If
Next Pic
End With

With ThisWorkbook.Worksheets("Garment Detail")
.Range("C5:D32").ClearContents
.Range("F12:G13").ClearContents
.Range("I6:J7").ClearContents
.Range("F6:G7").ClearContents
End With

With ThisWorkbook.Worksheets("New Style")
.Range("J9:L10").ClearContents
.Range("J13:L14").ClearContents
.Range("F14:H15").ClearContents
.Range("F18:H19").ClearContents
End With


ThisWorkbook.Worksheets("Welcome").Activate
For Each Sheet In ThisWorkbook.Worksheets
If Sheet.Name <> "Welcome" And Sheet.Visible <> xlSheetHidden Then
Sheet.Visible = xlSheetHidden
End If
Next Sheet

Application.ScreenUpdating = True

End Sub