how to remove data in a cell using vba macro

Hi,

I currently have a header that displays the result after my tab macro runs.

Within there, I want to remove anything that has a year in there. (i.e. 2015 or 2014).

How can I go about this using a vba macro in excel?

Thanks!

Sub Tab_Clients()
Dim lr As Long, MaxRow As Long
Dim ws As Worksheet
Dim WSPY As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim cCell As Range
Dim FirstAddress As String

'---> Disable Events
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

vcol = 1
Set ws = Sheets("Filtered from Current Year")
Set WSPY = Sheets("Filtered from Prev Year")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:BG1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
    On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
        ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
Next

myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).clear
For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
        Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
        Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    MaxRow = Sheets(myarr(i) & "").Range("A" & Sheets(myarr(i) & "").Rows.Count).End(xlUp).Row + 1
    
    '---> Get Data from Last Year
    With WSPY.UsedRange
        Set cCell = .Find(What:=myarr(i), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not cCell Is Nothing Then
            FirstAddress = cCell.Address
            Do
                cCell.EntireRow.Copy Sheets(myarr(i) & "").Range("A" & MaxRow)
                MaxRow = MaxRow + 1
                Set cCell = .FindNext(cCell)
            Loop While Not cCell Is Nothing And cCell.Address <> FirstAddress
        End If
    End With
    
    '---> Columns Autofit
    Sheets(myarr(i) & "").Columns.AutoFit

CHARTCLIENT2
Next
ws.AutoFilterMode = False
ws.Activate

'---> Enable Events
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'MsgBox "Creation of Clients tab done.", vbExclamation
End Sub

Open in new window


sample data sheet attached:
Sales-TY-LY-V01.xlsm
jfrank85Asked:
Who is Participating?
 
Wilder1626Commented:
Another simple way could be:
Dim rng As Long
rng = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Range("A1:ZZ" & rng).Replace What:="2015", Replacement:="", LookAt:=xlPart
Range("A1:ZZ" & rng).Replace What:="2014", Replacement:="", LookAt:=xlPart

Open in new window

0
 
Wilder1626Commented:
Hi

Do you want to clear the cell, delete the columns or delete the rows.

Ex to delete the columns if a cell as 2014:
For i = Cells(65536, 1).End(xlUp).Row To 1 Step -1
    For j = 1 To Cells(1, 1).End(xlToRight).Column
        If InStr(Cells(i, j), "2014") Then
            Columns(j).Delete
        End If
    Next
Next

Open in new window


Delete the rows
For i = Cells(65536, 1).End(xlUp).Row To 1 Step -1
    For j = 1 To Cells(1, 1).End(xlToRight).Column
        If InStr(Cells(i, j), "2014") Then
            Rows(i).Delete
        End If
    Next
Next

Open in new window


Clear cells data only
For i = Cells(65536, 1).End(xlUp).Row To 1 Step -1
    For j = 1 To Cells(1, 1).End(xlToRight).Column
        If InStr(Cells(i, j), "2014") Then
            Cells(i, j).Clear
        End If
    Next
Next

Open in new window

0
 
jfrank85Author Commented:
I want to keep the cell in tact and only remove the year from the cell.

so i.e. cells may say (total 3 cells):

2015 Total      2015 Average      % change versus 2015 Average

I'd want it to remove 2015 from each cell (total 3 cells) making it:

Total         Average                     % change versus Average
0
Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

 
Wilder1626Commented:
Is this what you are looking for?

Columns("A:ZZ").Select
Set c = Selection.Find(What:="2015", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False)
If Not c Is Nothing Then
    Do
        c.Replace What:="2015", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
        Cells(c.Row, 1).Value = Date
        Set c = Selection.FindNext(c)
    Loop While Not c Is Nothing
End If

Open in new window

0
 
jfrank85Author Commented:
works perfect. always super helpful!
0
 
Wilder1626Commented:
I'm glad I was able to help.
0
 
jfrank85Author Commented:
Jean-Marc -
This doesn't seem to be working right. Its actually also removing 2014 and 2015 in my column A. Any ideas? It should start from B1.

I tried this to modify and it's not working:

Sub RemoveDate()
Dim rng As Long
rng = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Range("B1:BH" & rng).Replace What:="2015", Replacement:="", LookAt:=xlPart
Range("B1:BH" & rng).Replace What:="2014", Replacement:="", LookAt:=xlPart
End Sub

Open in new window

0
 
Wilder1626Commented:
Hi.

The macro is not deleting in column A. Well not with the above code.

Something else must delete it in column A also.

Just try to only run the above macro only on your file and see if it removes from column A.

But it will not. Only from column B to BH.
0
 
jfrank85Author Commented:
sorry let me rephrase. it's not actually working from column B to BH.
0
 
Wilder1626Commented:
Can you give me an example of your excel file with some example in it where it does not delete the years?
0
 
jfrank85Author Commented:
user error. all good!
0
 
Wilder1626Commented:
Good news :-)

Please let me know if anything else happened.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.