VBA Help required

[PGD15]

Hi Guys,

I have written the below code.... I am trying to delete all column between B1 and M1 where the value is not equal to that in R1. (to get the column headings/cell references i need to delete first 13 rows)

With ActiveSheet
ActiveSheet.Rows("1:13").Delete
End With


With ActiveSheet
ActiveSheet.Range("R1:AC1").Value = Worksheets("Value").range("G1")




ActiveSheet.Range("B1").Select


Do Until ActiveCell.Value = ""


    If ActiveCell.Value = ActiveSheet.Range("r1") _
       Then


        ActiveCell.Offset(0, 1).Select


    Else


        ActiveCell.EntireColumn.Select
        Selection.Delete Shift:=xlToLeft
        Selection.End(xlUp).Select


    End If
Loop

can someone please help me get this to work. currently the formula deletes all the columns

 

[steve the fish]

If you delete that will shift R1. Is that what you want?

 

[PGD15]

I am aware hense the copy from range r1:ac1 (that covers all the deletes that will occur as there is a gap before r1)

If there is a way to shift the r1 reference that would work too but i used that line of code to prevent the issue you've highlighted

 

[steve the fish]

Heres how you can do the loop. Bear in mind that R1 will shift to the left if any columns are deleted. Also bear in mind there is no sheet qualification here so excel is going to use the activesheet.

Dim myVal As String, c As Range, rng As Range

myVal = Range("R1").Value

For Each c In Range("B1:M1")
    If c.Value <> myVal Then
        If Not rng Is Nothing Then
            Set rng = Union(rng, c)
        Else
            Set rng = c
        End If
    End If
Next

If Not rng Is Nothing Then rng.EntireColumn.Delete Shift:=xlToLeft

 

[PGD15]

Brillant thank you, works a treat! (i had to add in the activesheet bit though as this is on a command button so i accidentally deleted my report tab first time round :') being a pleb) but many thanks!

 

[steve the fish]

As it happens you would still have deleted the report tab if you use activesheet. By not using a sheet name with Range you ARE using activesheet. What you should try is:

With Sheets("Sheet1")
    myVal = .Range("R1").Value
    For Each c In .Range("B1:M1")
        If c.Value <> myVal Then
            If Not rng Is Nothing Then
                Set rng = Union(rng, c)
            Else
                Set rng = c
            End If
        End If
    Next
End With
If Not rng Is Nothing Then rng.EntireColumn.Delete Shift:=xlToLeft

Replace Sheet1 with your target sheet name.

 

[PGD15]

no because i have a line above which adds a new sheet into the workfile and makes it the active sheet so then this formula works using the new tab as the active sheet (info is pasted from internet inbetween the lines)

it works nonetheless i just couldn't figure out the bit you sent me :') so many thanks!