Thread: Delete Content in a row while opening

Yes, of course I mean the column - Sorry!

Little extra: Is should start deleting the whole column starting in row '2' (there is a heading in row 1...)

Thank you very much.

Hello TMShucks,

Sorry it does not work -

maybe it is easier if the code should delete all columns 'AA' (starting with AA2) in all worksheets in the workbook...
but only if I open up the whole workbook for the first time, not while I am working in the workbook and switching from sheet to sheet...

Thank you

hmm... okay maybe it does not work because there are other codes and I tried to implement your code in the wrong position...

this is the complet code and I put yours just on the top.

FYI: The worksheet is called "ALL", not "Sheet1" anymore

Private Sub Workbook_Open()
With Sheets("ALL")
    .Range("AA2:AA" & Rows.Count).Clear
End With
End Sub

Private Sub Worksheet_Activate()
Dim ws As Worksheet
Dim lngLast As Long
Const strForbiddenWorksheetNames As String = "ALL#FTW#APP#ACC"

Me.Cells.Clear
Worksheets("FTW SS 12").Rows(1).Copy _
  Destination:=Me.Rows(1)

For Each ws In ThisWorkbook.Worksheets
  If InStr(1, strForbiddenWorksheetNames, ws.Name, vbTextCompare) = 0 Then
    lngLast = ws.Cells(Rows.Count, 1).End(xlUp).Row
    ws.Range("A2:AA" & lngLast).Copy _
      Destination:=Me.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  End If
Next ws

'Aufruf der beiden Subs für das Bereinigen der Liste
NiederMitDenDoppelten
'...und das Kopieren der Bereiche mit Eintragungen in Spalte AA
kopiereGewählte

Me.UsedRange.Sort Key1:=Me.Range("K2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub

Private Sub NiederMitDenDoppelten()
'Schlüsselfelder in der Tabelle:
'5,6,9,11,13,27
'entsprechen Feldern im Array fWerte:
'1,2,5,7,9,23

Dim fWerte As Variant, i As Long
Dim dic As Object, strKeyTemp As String
Dim rngWegmachen As Range

Set dic = CreateObject("Scripting.Dictionary")
fWerte = Me.Range("E1:AA" & Me.Cells(Rows.Count, 1).End(xlUp).Row)
For i = LBound(fWerte, 1) + 1 To UBound(fWerte, 1)
  strKeyTemp = fWerte(i, 1) & "###" & fWerte(i, 2) & "###" & fWerte(i, 5) & "###" & fWerte(i, 7) & "###" & fWerte(i, 9) & "###" & fWerte(i, 23)
  If dic.exists(strKeyTemp) Then
    If rngWegmachen Is Nothing Then
      Set rngWegmachen = Rows(i)
    Else
      Set rngWegmachen = Union(rngWegmachen, Rows(i))
    End If
  Else
    dic(strKeyTemp) = 0
  End If
Next i
If Not rngWegmachen Is Nothing Then rngWegmachen.EntireRow.Delete
Set dic = Nothing
End Sub

Sub kopiereGewählte()
'"X" oder irgend ein anderes fest eingetragenes Kennzeichen in Spalte AA
Dim wbZiel As Workbook

Set wbZiel = Workbooks.Open("K:\_IPM Team\_Julian\TESTTimeline.xlsm")

wbZiel.Worksheets(1).Cells.ClearContents

With ThisWorkbook.Worksheets("ALL")
   Intersect(.Range("A:Z"), _
         .Columns("AA").SpecialCells(xlCellTypeConstants).EntireRow).Copy _
            Destination:=wbZiel.Worksheets(1).Range("A2")
End With

wbZiel.Close savechanges:=True
Set wbZiel = Nothing
End Sub

sorry - I am a rookie

May I ask you that you adopt your code in mine so that it works?
I am not able to do it on my own - embarassing

Thank you in advance.

Thank you for your work.
It lookes almost very good =)


Little exception:

Option Explicit

Private Sub Workbook_Open()
With Sheets("ALL")
    .Range("AA2:AA" & Rows.Count).Clear
End With
End Sub

It only deletes the content in shhet "ALL" - and now sometimes I want to change the code that in all worksheets the column AA (starting AA2) gets deleted.

what do I have to change:

I tried this code, but it does not work:

Option Explicit

Private Sub Workbook_Open()
For Each ws In ThisWorkbook
    .Range("AA2:AA" & Rows.Count).Clear
End With
End Sub

help?
Thank you


P.S. "the" code took me forever to make it the way it is... you can not imagine

ok looks perfect - thank you!