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
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Forum statistics

Threads
1,215,016
Messages
6,122,700
Members
449,092
Latest member
snoom82

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
Back
Top