Problem deleting column from multiple sheets

[Mindpsyche]

Hello,

I am using this in part of my code to delete an entire column. However, this is happening only for the first sheet and not the others.

When i use this method by itself without it being part of the bigger code, it seems to work.

Sheets.Select False
            Sheets(1).Activate
            Cells(1, MaxColumn).EntireColumn.Select
            With Selection
                .Delete Shift:=xlShiftToLeft
            End With

Below is the whole code of the macro which includes the above. I'm still very new to VBA so don't be surprised if you see any disorganization or crude methods in my code.

Sub Test_Rephase()
'Ok Clicked
    
' RecordingMaxFormula Macro
' Macro recorded 4/26/2012 by 703064732 (Syed Ahmed Khan)
    Application.ScreenUpdating = False
    
    ' Star Timer
    Dim time1, time2 As Double
    time1 = Timer
    
    'Deleting IRI_WorkspaceStorage Sheet
    Sheets("IRI_WorkspaceStorage").Visible = True
    Application.DisplayAlerts = False
    Sheets("IRI_WorkspaceStorage").Delete
    Application.DisplayAlerts = True
'    Typing in Periodes P1 to P39 or P36
    Dim yt, zt, tnop As Long
    tnop = InputBox("Total number of periods")
    Sheets.Select False
    Sheets(1).Activate
        For zt = 1 To tnop
            Dim tt As Long
            tt = 6 + zt
            Cells(5, tt).Select
            ActiveCell.Value = "P" & zt
            ActiveCell.Offset(0, 1).Select
        Next
        
    ' Setting up MAX Based on Userform Criteria
    Sheets(1).Select
    Dim Fp, Lp, Fpf, Lpf, MaxColumn As Long
    Fp = InputBox("1st Period")
    Lp = InputBox("2nd period")
    Fpf = 6 + Fp
    Lpf = 6 + Lp
    Dim Rowcount, Rowcounts, Columncount As Long
    Rowcount = Cells(Rows.Count, 1).End(xlUp).Row
    Columncount = Cells(6, Columns.Count).End(xlToLeft).Column
    MaxColumn = Columncount + 1
    For Rowcounts = 6 To Rowcount
    Dim rx As Range
    Set rx = Range(Cells(Rowcounts, Fpf), Cells(Rowcounts, Lpf))
    Dim s As Double
    Cells(Rowcounts, MaxColumn).Select
    s = Application.WorksheetFunction.Max(rx)
    ActiveCell.Value = s
    Next Rowcounts
    
    'Copying MAX values to all other sheets
    Dim wsheet As Worksheet
    Application.ScreenUpdating = False
    Dim wsheetcount, sca As Double
    Dim MaxRange As Range
    Set MaxRange = Range(Cells(6, MaxColumn), Cells(Rowcount, MaxColumn))
    wsheetcount = Application.Worksheets.Count
    For sca = 2 To wsheetcount
        Sheets(1).Activate
            MaxRange.Select
            Selection.Copy
        Sheets(sca).Activate
            Cells(6, MaxColumn).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Next sca
    
    ' Filtering based on MAX
    Dim Flt As String
    Flt = 30
    For Each wsheet In Worksheets
        wsheet.Activate
        Cells(1, MaxColumn).EntireColumn.Select
            With Selection
                .AutoFilter field:=1, Criteria1:="<=" & Flt
                .Resize(Rows.Count - 5).Offset(5).EntireRow.Delete
            End With
                Selection.AutoFilter ' Removes filters
    Next wsheet
    
'     Deleting MAX Column
            Sheets.Select False
            Sheets(1).Activate
            Cells(1, MaxColumn).EntireColumn.Select
            With Selection
                .Delete Shift:=xlShiftToLeft
            End With
    'Rephasing
    Dim Str As Integer
    Str = 7
    Dim LR As Long, LC As Long, i As Long, j As Long, r As Range
    Sheets.Select False
    Sheets(1).Activate
    LR = Cells(Rows.Count, 6).End(xlUp).Row
    For i = 1 To LR
    LC = Cells(i, Columns.Count).End(xlToLeft).Column
    Set r = Nothing
    For j = 7 To LC
    If Cells(i, j).Value <= Str Then
      Set r = Union(Cells(i, j), IIf(r Is Nothing, Cells(i, j), r))
    Else
      Exit For
    End If
    Next j
    If Not r Is Nothing Then
    r.Select
    Selection.Delete Shift:=xlShiftToLeft
    End If
    Next i
    
' Naming geography and measures in cells A3 of each sheet and disabling gridlines
    Dim ws As Worksheet
    For Each ws In Worksheets
            Dim measname As String
            measname = ws.Name
            ws.Range("A2").Value = "Hypers" & " " & "-" & " " & measname
            ActiveWindow.DisplayGridlines = False
    Next ws
            Sheets.Select False
            Sheets(1).Activate
            Range("A2").Select
            Selection.Font.Bold = True
            Range("G2").Select
            Selection.Delete Shift:=xlToLeft
' Formatting
    Sheets.Select False
    Sheets(1).Activate
    For i = 6 To LR
            LC = Cells(i, Columns.Count).End(xlToLeft).Column
            Set r = Range(Cells(i, 1), Cells(i, LC))
                r.Select
            Set r = Range(Cells(i, 1), Cells(i, LC))
                r.Select
                        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                        With Selection.Borders
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .ColorIndex = xlAutomatic
                        End With
    Next i
                Range(Cells(5, 7), Cells(5, 7).End(xlToRight)).Select
                With Selection.Borders
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .ColorIndex = xlAutomatic
                End With
                With Selection
                    .Font.Bold = True
                    .HorizontalAlignment = xlCenter
                End With
                Rows("3:4").Select
                Selection.Delete Shift:=xlUp
' Filling color in cells with data

    Dim ac, bc, xc, yc, zc As Long
    zc = Range(Cells(4, 1), Cells(4, 1).End(xlDown)).Count
    ac = zc + 3
    Sheets.Select
    Sheets(1).Activate
    For yc = 4 To ac
        xc = Cells(yc, Columns.Count).End(xlToLeft).Column
        If xc = 7 Then
        Cells(yc, xc).Select
        With Selection.Interior
            .ColorIndex = 37
            .Pattern = xlSolid
        End With
        ElseIf xc > 7 Then
        Range(Cells(yc, 7), Cells(yc, xc)).Select
        With Selection.Interior
            .ColorIndex = 37
            .Pattern = xlSolid
        End With
        End If
    Next yc
    Columns("G:AS").Select
    Selection.ColumnWidth = 15
 
' Stop timer
    time2 = Timer
    MsgBox "Rephasing complete in " & Format(time2 - time1, " 0 \sec")
    Sheets(1).Select
    Dim nop As Double, rows1 As Range
    Set rows1 = Range(Range("A4"), Range("A4").End(xlDown))
    nop = Application.WorksheetFunction.CountA(rows1)
    MsgBox "Number of Products = " & nop
'Unload UserForm2
' Message box to run Decimal Check Macros
'    MsgBox "Now run Macro called DecimalCheck1"
'    Call DecimalCheck1
End Sub

 

[Mindpsyche]

Bump!

 

[abi_learn_vba]

Hi,

Your code itself says that you are deleting only the column in the first sheet (Sheet(1)).

You can use below code to delete a particular column of all sheets in your workbook.

Dim MaxColumn As Integer
Dim sht As Worksheet
MaxColumn = 1 'i have used first column for this eg.
For Each sht In Worksheets
     sht.Cells(1,MaxColumn).EntireColumn.Delete Shift:= xlShiftToLeft
Next sht

Regards
-Abi

 

[Mindpsyche]

Hi,

Your code itself says that you are deleting only the column in the first sheet (Sheet(1)).

You can use below code to delete a particular column of all sheets in your workbook.

Dim MaxColumn As Integer
Dim sht As Worksheet
MaxColumn = 1 'i have used first column for this eg.
For Each sht In Worksheets
     sht.Cells(1,MaxColumn).EntireColumn.Delete Shift:= xlShiftToLeft
Next sht

Regards
-Abi

Thanks will give this a try. But I had:

Sheets.Select False
Sheets(1).activate

This selects all sheets, but only activates 1....it seems to work otherwise.

 

[Mindpsyche]

Alright, this loop worked but what happens when i put in this loop is that the next part of my macro works in correctly: (In this part of the code, the variable MaxColumn is not used so deleting the MaxColumn should not matter). Please read my comments in the code for a better understanding.

'     Deleting MAX Column (This works only for sheet1)
    Sheets.Select False 
            Sheets(1).Activate
            Cells(1, MaxColumn).EntireColumn.Select
            With Selection
                .Delete Shift:=xlShiftToLeft
            End With
 
' When I substitue the code above with your code, the code below does not work as intended.
 
    'Rephasing
    Dim Str As Integer
    Str = 7
    Dim LR As Long, LC As Long, i As Long, j As Long, r As Range
    Sheets.Select False
    Sheets(1).Activate
    LR = Cells(Rows.Count, 6).End(xlUp).Row
    For i = 1 To LR
    LC = Cells(i, Columns.Count).End(xlToLeft).Column
    Set r = Nothing
    For j = 7 To LC
    If Cells(i, j).Value <= Str Then
      Set r = Union(Cells(i, j), IIf(r Is Nothing, Cells(i, j), r))
    Else
      Exit For
    End If
    Next j
    If Not r Is Nothing Then
    r.Select
    Selection.Delete Shift:=xlShiftToLeft
    End If
    Next i

Thanks for any input.

 

[abi_learn_vba]

My Bad I did not see this.

Sheets.Select False

What is that going wrong in the "'Rephasing" Part?

Rgds
-Abi

 

[Mindpsyche]

My Bad I did not see this.

Sheets.Select False

What is that going wrong in the "'Rephasing" Part?

Rgds
-Abi

Hey i figured out the problem. If you see my code right above the part which deletes the column. It is a loop that ends on the last sheet.

Then i had

Sheets.select False

Which activated all sheets, with the last sheet active. If i had to delete the column right away it would have been ok but then i had

Sheets(1).activate

Entering this broke my selection of all sheets.

Because of this one line I spent almost a week braking my head over this.

Anyway, fixed now and thanks for your help.