Macro is not working when I delete columns

cagataybaser

New Member
Joined
Jul 28, 2014
Messages
34
Hello everyone,
I created 3 buttons and 3 checkboxes in my custom tab which I used xml.
"Gizle" hides columns
"sifirla" shows columns
"sil" opens userform and if you write the column names such as f2,f3,f4 and it deletes.
My problem is when I delete column checkboxes doesnt work anymore,I have to close the excel and open it again
Thank you for helping.

Xml codes
Code:
[FONT=Courier New]<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" o n L o a d="O n L o a d">

   <ribbon startFromScratch="false">
      <tabs> <tab id="customTab" label="Ozel sekmem" keytip ="C">
      <group  id="Group1" label="Group1">
   <button id="button3" label="gizle" onAction="Gizle_Makro" />
   <button id="button1" label="sifirla" onAction="Sifirla_Makro" />
   <button id="button4" label="sil" onAction="Sil_Makro" />
      <checkBox id ="F2"    getPressed="GetPressed"  getLabel="GetLabel" onAction="KOLONAC" />
      <checkBox id ="F3"   getPressed="GetPressed" getLabel="GetLabel" onAction="KOLONAC" />
   <checkBox id= "F4" getPressed="GetPressed" getLabel="GetLabel" onAction="KOLONAC" />
            </group>
         </tab>

      </tabs>
   </ribbon>
</customUI>[/FONT]

Vba codes
Code:
[FONT=Courier New]Option Explicit
Dim bChk(0 To 3) As Boolean
Public objRibbon As IRibbonUI
Public Sub O n L o a d(ribbon As IRibbonUI)
Dim i As Long
For i = 0 To 3
bChk(i) = True
Next i
  Set objRibbon = ribbon
  objRibbon.Invalidate
End Sub
Sub KOLONAC(control As IRibbonControl, pressed As Boolean)
    Search control.ID, pressed
End Sub
Sub Search(fnd As String, pressed As Boolean)
    Dim firstfound As String, foundcell As Range, rng As Range, myRange As Range, lastcell As Range
    Set myRange = ActiveSheet.UsedRange
    Set lastcell = myRange.Cells(myRange.Cells.Count)
    Set foundcell = myRange.Find(what:=fnd, after:=lastcell, Lookat:=xlWhole)
    If Not foundcell Is Nothing Then
        firstfound = foundcell.Address
        Do
            foundcell.EntireColumn.Hidden = Not pressed
            Set foundcell = myRange.FindNext(after:=foundcell)
        Loop While Not foundcell Is Nothing And foundcell.Address <> firstfound
    End If
End Sub

Sub sifirla_makro(control As IRibbonControl)
Dim i As Long
For i = 0 To 3
bChk(i) = True
Next i
Cells.EntireColumn.Hidden = False
objRibbon.Invalidate
End Sub
Function GetChkBox(ByVal sString) As String
Select Case sString
Case "F2"
GetChkBox = "0"
Case "F3"
GetChkBox = "1"
Case "F4"
GetChkBox = "2"
End Select
End Function


Sub Sil_makro(control As IRibbonControl)
UserForm1.Show
End Sub
Sub Gizle_Makro(control As IRibbonControl)
Dim i As Long
For i = 0 To 3
bChk(i) = False
Next i
  Sheets("Sayfa1").Columns("B:ZZ").Hidden = True
  objRibbon.Invalidate
End Sub

Sub GetLabel(control As IRibbonControl, ByRef Label)
Select Case control.ID
Case "F2"
Label = Range("B8").Value
Case "F3"
Label = Range("C8").Value
Case "F4"
Label = Range("D8").Value
End Select
End Sub
Sub GetPressed(control As IRibbonControl, ByRef Button)
Button = bChk(GetChkBox(control.ID))
End Sub


'Userform1 icinde yaratılan bir adet textbox ve button var
Private Sub CommandButton1_Click()
MSG1 = MsgBox("Silmek istediginizden emin misiniz?", vbYesNo, "Sil?")
If MSG1 = vbYes Then
Dim firstfound As String
Dim foundcell As Range, rng As Range, rng1 As Range
Dim myRange As Range, lastcell As Range
Dim fnd As String
Dim rowcell As Range

fnd = UserForm1.TextBox1.Value
Dim rngFound As Range, rngToDelete As Range
Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long
    
    With Sheets("Sayfa1").Range("A:A")
            Set rng = .Find(what:="BASISWERT " + UCase(fnd), _
                            after:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
                    End With
                    On Error Resume Next
                
    rng.Offset(1, 0).EntireRow.Delete
    rng.Offset(0, 0).EntireRow.Delete
     
            
    
    Set myRange = ActiveSheet.UsedRange
    Set lastcell = myRange.Cells(myRange.Cells.Count)
    Set foundcell = myRange.Find(what:=fnd, after:=lastcell)
If Not foundcell Is Nothing Then
    firstfound = foundcell.Address
  End If
Set rng = foundcell
  Do Until foundcell Is Nothing
      Set foundcell = myRange.FindNext(after:=foundcell)
      Set rng = Union(rng, foundcell)
      If foundcell.Address = firstfound Then Exit Do
  Loop
  rng.EntireColumn.Delete
Else
  Exit Sub
End If
End Sub[/FONT]


And example file : Sutun silince makro çal
 

Some videos you may like

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

Watch MrExcel Video

Forum statistics

Threads
1,108,507
Messages
5,523,309
Members
409,510
Latest member
HQ2401

This Week's Hot Topics

Top