Check column and delete each row if a cell value = a string or it is empty

TitoElan

New Member
Joined
Jun 10, 2022
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Hi, I am trying to edit or make some old vba code work.
After copying a Range from one workbook and pasting them into another (and it works) that part of the vba code should check a column and if any cell contains a certain string or is empty, the row should be deleted.
With the empty cells the code are working and deleting the rows. With the strings not. But I dont even understand how it is working.

The variable for searching the strings is the
"KeinProfil =...."
Thats what is not working

With the line " this = UCase(Trim(Selection.Cells(1, 2).Value & Selection.Cells(1, 3).Value))" the code is finding correctly the empty cells. But thats what I dont understand.
The code runs till the end with no errors.

I've been trying to fix it but couldn't find the solution :/

VBA Code:
    last = UCase(Trim(Range("B6").Value & Range("C6").Value))
GewichtAnfang = "F6"
LaengeAnfang = "G6"
KeinProfil = "$Gesamtstückzahl$Länge FW-Abschnitt [m]$Nettogewicht FW$Neigung(ja=1):"
KeinProfil = KeinProfil & "$Endstirnplatten (0=gelenkig; 1=biegesteif):$Länge FW-Träger [m]"
KeinProfil = KeinProfil & "$Beanspruchungsgruppe$Eingabe: ja/nein$Satteldach$auslegen+messen"
KeinProfil = KeinProfil & "$nur Montageaufwand, kein Materialpreis$HM28x15, l=100mm$22x175"
KeinProfil = KeinProfil & "$Materialdicke/Umfang$Fl35x25$%"
KeinProfil = KeinProfil & "$"
For i = 6 To 5000
   iRow = i & ":" & i
   Rows(iRow).Select
   this = UCase(Trim(Selection.Cells(1, 2).Value & Selection.Cells(1, 3).Value))
   If InStr(KeinProfil, "$" & this & "$") > 0 Then
      Rows(iRow).Delete
      last = this
      i = i - 1
   Else
      If this = "" Then
         Call Zwischensumme(i, GewichtAnfang, LaengeAnfang)
        'If MsgBox("Jetzt wird gelöscht", vbOKCancel) = vbCancel Then Stop
         Loeschbereich = i & ":5000"
         Rows(Loeschbereich).Delete
         i = 5000
      Else
         If this <> last Then
            Call Zwischensumme(i, GewichtAnfang, LaengeAnfang)
            GewichtAnfang = "F" & i
            LaengeAnfang = "G" & i
           'If MsgBox(last, vbOKCancel) = vbCancel Then Stop
         End If
        last = this
      End If
   End If
Next
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Alex Blakenburg

MrExcel MVP
Joined
Feb 23, 2021
Messages
4,442
Office Version
  1. 365
Platform
  1. Windows
Can you give us an XL2BB of some of the data ?
In particular show us what you have in columns B & C in rows you think should be picked up for deletion.
 

TitoElan

New Member
Joined
Jun 10, 2022
Messages
16
Office Version
  1. 365
Platform
  1. Windows
I dont have the addin here but maybe it is enough with a screenshoot.
There for example. If the code finds the string "Materialdicke/Umfang" the row should be deleted. For that case the code has the line:
KeinProfil = KeinProfil & "$Materialdicke/Umfang$Fl35x25$%"

Unbenannt.PNG
 

Alex Blakenburg

MrExcel MVP
Joined
Feb 23, 2021
Messages
4,442
Office Version
  1. 365
Platform
  1. Windows
Its never going to find it because the code is adding "$" to the beginning and end of it before looking in KeinProfil, so in your example it is going to look for
$Materialdicke/Umfang$ which doesn't exist in KeinProfil.

In the code
this = Materialdicke/Umfang
but the search is:
Rich (BB code):
 If InStr(KeinProfil, "$" & this & "$") > 0 Then

Try changing it to
Rich (BB code):
 If InStr(KeinProfil, this) > 0 Then
 

TitoElan

New Member
Joined
Jun 10, 2022
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Thanks for your help but it doesnt work. I get no errors with that change but the macro causes excel to not respond. I have to close Excel using the task manager. :/
 

Alex Blakenburg

MrExcel MVP
Joined
Feb 23, 2021
Messages
4,442
Office Version
  1. 365
Platform
  1. Windows
OK I missed that you used UCase on your find string. Instr is case sensitive but you have UCase'd one half but not the other.
You don't need the UCase you are better off changing your If statement to the below.
(This below should work whether you remove the UCase or not)

VBA Code:
If InStr(1, KeinProfil, this, vbTextCompare) > 0 Then
 

TitoElan

New Member
Joined
Jun 10, 2022
Messages
16
Office Version
  1. 365
Platform
  1. Windows
I deleted the "Application.ScreenUpdating = False" to see if the code makes anything and yes. It started and with your suggestion it makes a loop with a circle reference at F6 and G6. Here is the code complete. Maybe it helps.

VBA Code:
Dim Title
Dim neueMappe
Dim breit As Range

Sub Materialliste_erzeugen(control As IRibbonControl, pressed As Boolean)
'
' Materialliste_erzeugen Makro

    Application.ScreenUpdating = False
    Title = Application.ActiveWorkbook.Name
    Columns("A:P").Select
    Selection.Copy
    Workbooks.Add
    neueMappe = ActiveWorkbook.Name
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Workbooks(Title).Activate
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks(neueMappe).Activate
    Columns("A:P").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone

    Application.CutCopyMode = False
    Columns("I:I").Select
    Columns("I:I").Cut Destination:=Columns("D:D")
    Columns("L:L").Select
    Selection.Cut Destination:=Columns("I:I")
    Columns("P:P").Select
    Columns("P:P").Cut Destination:=Columns("J:J")
    Range("M1:M3").Select
    Range("M1:M3").Cut Destination:=Range("I1:I3")
    Columns("N:N").Select
    Columns("N:N").Cut Destination:=Columns("K:K")
    Range("O1:O3").Select
    Selection.Cut Destination:=Range("K1:K3")
    Columns("L:P").Select
    Selection.Delete Shift:=xlToLeft
    Range("C1:C3").Select
    Selection.Cut Destination:=Range("D1:D3")
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "Materialliste"
    Columns("A:C").Select
    Range("C1").Activate
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "G�te"
    Range("D5").Select
    Selection.Copy
    Range("D4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("E4").Select
    Selection.Copy
    Range("D5").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("E5").Select
    Selection.Copy
    Range("E4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("D5").Select
    Selection.Copy
    Range("E5").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "Gesamtgewicht"
    Range("F5").Select
    ActiveCell.FormulaR1C1 = "[to]"
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "Gesamtl�ngen"
    Range("G5").Select
    Columns("G:G").EntireColumn.AutoFit
    Range("E5").Select
    Selection.Copy
    Range("G5").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("F1:F3").Select
    Selection.Cut Destination:=Range("G1:G3")
    Range("H1:H3").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("D:G").Select
    Selection.NumberFormat = "0.00"
    Range("A1:A3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B1:B3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("C1:F3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("G1:H3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A4:A5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B4:B5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("C4:C5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("D4:D5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("E4:E5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("F4:F5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("F:F").ColumnWidth = 7.86
    Range("F4:F5").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("G4:G5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("H4:H5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A6:H5000").Select
    Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("I1").Select
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$4:$5"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = "&D"
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = "&F"
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.787401575)
        .RightMargin = Application.InchesToPoints(0.787401575)
        .TopMargin = Application.InchesToPoints(0.984251969)
        .BottomMargin = Application.InchesToPoints(0.984251969)
        .HeaderMargin = Application.InchesToPoints(0.4921259845)
        .FooterMargin = Application.InchesToPoints(0.4921259845)
        .PrintHeadings = False
        .PrintGridlines = True
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 4
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    Columns("A:H").Select
    ActiveSheet.PageSetup.PrintArea = "$A:$H"

    
    last = UCase(Trim(Range("B6").Value & Range("C6").Value))
GewichtAnfang = "F6"
LaengeAnfang = "G6"
KeinProfil = "$Gesamtst�ckzahl$L�nge FW-Abschnitt [m]$Nettogewicht FW$Neigung(ja=1):"
KeinProfil = KeinProfil & "$Endstirnplatten (0=gelenkig; 1=biegesteif):$L�nge FW-Tr�ger [m]"
KeinProfil = KeinProfil & "$Beanspruchungsgruppe$Eingabe: ja/nein$Satteldach$auslegen+messen"
KeinProfil = KeinProfil & "$nur Montageaufwand, kein Materialpreis$HM28x15, l=100mm$22x175"
KeinProfil = KeinProfil & "$Materialdicke/Umfang$Fl35x25$%"
KeinProfil = KeinProfil & "$"
For i = 6 To 5000
   iRow = i & ":" & i
   Rows(iRow).Select
   this = Trim(Selection.Cells(1, 2).Value & Selection.Cells(1, 3).Value)
   If InStr(1, KeinProfil, this, vbTextCompare) > 0 Then
      Rows(iRow).Delete
      last = this
      i = i - 1
   Else
      If this = "" Then
         Call Zwischensumme(i, GewichtAnfang, LaengeAnfang)
        'If MsgBox("Jetzt wird gel�scht", vbOKCancel) = vbCancel Then Stop
         Loeschbereich = i & ":5000"
         Rows(Loeschbereich).Delete
         i = 5000
      Else
         If this <> last Then
            Call Zwischensumme(i, GewichtAnfang, LaengeAnfang)
            GewichtAnfang = "F" & i
            LaengeAnfang = "G" & i
           'If MsgBox(last, vbOKCancel) = vbCancel Then Stop
         End If
        last = this
      End If
   End If
Next

    
    Range("I1").Select

    Application.ScreenUpdating = True

    
    MsgBox "Materialliste erstellt", Title:="Materialliste"
    
End Sub


Sub Zwischensumme(i, ByVal GewichtAnfang As String, ByVal LaengeAnfang As String)
          Selection.Insert (xlDown)
          Selection.Insert (xlDown)
          SummeGewicht = "F" & i
          SummeLaenge = "G" & i
          GewichtEnde = "F" & i - 1
          LaengeEnde = "G" & i - 1
          Range(SummeGewicht).Formula = "=SUM(" & GewichtAnfang & ":" & GewichtEnde & ")"
          Range(SummeGewicht).Interior.ColorIndex = 20
          Range(SummeGewicht).Offset(0, -4).Value = "Summe"
          Range(SummeGewicht).Offset(0, -4).Font.Bold = True
          Range(SummeGewicht).Offset(0, -4).Interior.ColorIndex = 20
          Range(SummeLaenge).Formula = "=SUM(" & LaengeAnfang & ":" & LaengeEnde & ")"
          Range(SummeLaenge).Interior.ColorIndex = 20
          i = i + 2
          
    Columns("A:A").Columns.AutoFit
    Columns("F:F").Columns.AutoFit
    Columns("K:K").Columns.AutoFit
    Columns("D:D").Columns.AutoFit
    Columns("H:H").Columns.AutoFit
          
         
End Sub
 

Alex Blakenburg

MrExcel MVP
Joined
Feb 23, 2021
Messages
4,442
Office Version
  1. 365
Platform
  1. Windows
Can I just confirm that you are ok now ?

Assuming the code is working the next step is to remove all the references to Activate and Select. They make the code harder to follow and also make it run slow.
eg everywhere you have something like this:
VBA Code:
    Columns("I:I").Select
    Columns("I:I").Cut Destination:=Columns("D:D")
    Columns("L:L").Select
    Selection.Cut Destination:=Columns("I:I")

Remove the "select" reference and effectively oin the 2 lines:
VBA Code:
    Columns("I:I").Cut Destination:=Columns("D:D")
    Columns("L:L").Cut Destination:=Columns("I:I")
 

TitoElan

New Member
Joined
Jun 10, 2022
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Can I just confirm that you are ok now ?

Assuming the code is working the next step is to remove all the references to Activate and Select. They make the code harder to follow and also make it run slow.
eg everywhere you have something like this:
VBA Code:
    Columns("I:I").Select
    Columns("I:I").Cut Destination:=Columns("D:D")
    Columns("L:L").Select
    Selection.Cut Destination:=Columns("I:I")

Remove the "select" reference and effectively oin the 2 lines:
VBA Code:
    Columns("I:I").Cut Destination:=Columns("D:D")
    Columns("L:L").Cut Destination:=Columns("I:I")
No, what I mean is that the code is not working with the line
VBA Code:
        If InStr(1, KeinProfil, this, vbTextCompare) > 0 Then
Till some point yes but then excel doesnt respond anymore before the macro runs to the end and I have to close excel with the task manager.
 

Alex Blakenburg

MrExcel MVP
Joined
Feb 23, 2021
Messages
4,442
Office Version
  1. 365
Platform
  1. Windows
This looks like a very dangerous piece of code to me. What are you trying to do with this ?
VBA Code:
      If this = "" Then
         Call Zwischensumme(i, GewichtAnfang, LaengeAnfang)
        'If MsgBox("Jetzt wird gel�scht", vbOKCancel) = vbCancel Then Stop
         Loeschbereich = i & ":5000"
         Rows(Loeschbereich).Delete
         i = 5000
 

Forum statistics

Threads
1,171,195
Messages
5,874,278
Members
433,042
Latest member
mcm2022

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
Top