Home > Enterprise >  How can I make this VBA loop work until the end
How can I make this VBA loop work until the end

Time:02-02

I have tried countless ways to put this simple loop to work, but it seems like it just won't work! I just wan't to remove a repeating year at the end of some dates in a column and replace those by the right year. I started by doing this with a nested for loop in a single module, then I changed the code to be used for each sheet in it's relative module... Also tried replacing the repeating year with nothing and then adding the right year but it always hangs at the middle! This is such a simple thing and I don't understand why it is not working... Is it a bug related to the formating? Is the code not well programmed somehow and not efficient or too heavy? I don't know!

Sub change_dates()

Dim wb As Workbook
Dim o As Long
Dim k As Long
Dim y As Long

Set wb = ThisWorkbook

y = Year(Date)
o = 2
k = wb.Worksheets(11).Cells(2, 10).Value   2

Do While o < k

            If Mid(wb.Worksheets(11).Cells(o, 1), 4, 2) = 12 Then
            y = y - 1
            End If
            wb.Worksheets(11).Cells(o, 1) = Left(wb.Worksheets(11).Cells(o, 1), 6) & CStr(y)
o = o   1
Loop

End Sub

This is exactly how the cells values become after I run the vba code:

...
14/03/2014
14/02/2014
14/01/2014
13/12/2013
13/11/2013
13/10/2013
13/09/2013
13/08/2013
13/07/2013
13/06/2013
13/05/2013
13/04/2013
13/03/2013
13/02/2013
13/01/2013
    12-12-2012
    11-12-2012
    10-12-2012
    09-12-2012
    08-12-2012
    07-12-2012
    06-12-2012
    05-12-2012
    04-12-2012
    03-12-2012
    02-12-2012
    01-12-2012
    12-11-2011
    11-11-2011
    ...

As you can see the first part is how I want, and with the same running code the second part is not how I want! The month is changing and the formatting too. Bellow there are the original values of the column, which I simply what to change the repeating year!

...
22-01-2022
21-12-2022
21-11-2022
21-10-2022
21-09-2022
21-08-2022
21-07-2022
21-06-2022
21-05-2022
21-04-2022
21-03-2022
21-02-2022
21-01-2022
20-12-2022
20-11-2022
20-10-2022
20-09-2022
20-08-2022
20-07-2022
20-06-2022
...

This is the desired result:

22-01-2022
21-12-2021
21-11-2021
21-10-2021
21-09-2021
21-08-2021
21-07-2021
21-06-2021
21-05-2021
21-04-2021
21-03-2021
21-02-2021
21-01-2021
20-12-2020
20-11-2020
20-10-2020
20-09-2020
20-08-2020
20-07-2020
...

Further clarifications:

  • I get date as a result of =A2 1.
  • The A column cells are all formatted like this dd-mm-aaaa
  • k is returning the right number.
  • The result should look like all the days and months remaining the same, and the repeating year 2022 changes to a year that starts in 2022 and decreases by one starting from the top down everytime it's December.

CodePudding user response:

The issue is if you use text/string functions like Mid() or Left() you change from a real numeric date (you can actually calculate with) to a text that only looks like a date but is just text (you cannot calculate with that anymore). And Excel does not know that this is a date.

So whenever working with dates use numeric date functions like Day(), Month() and Year() to split the date into parts and use DateSerial(y, m, d) to put a new date together. This will create a real numeric date you can calculate with, and that you can format with .NumberFormat.

I changed your Do loop into a For loop that auto increments o on Next o, this looks a bit cleaner.

Public Sub change_dates()
    Dim ws As Worksheet  ' define your worksheet only once
    Set ws = ThisWorkbook.Worksheets(11) ' if it ever changes from 11 to 12 it only needs to be changed here
    
    Dim y As Long
    y = Year(Date)
    
    Dim k As Long
    k = ws.Cells(2, 10).Value   1
    
    Dim o As Long
    For o = 2 To k  ' loop from 2 to k
        Dim m As Long  ' get month of current cell
        m = Month(ws.Cells(o, 1))
        
        Dim d As Long  ' get day of current cell
        d = Day(ws.Cells(o, 1))
        
        If m = 12 Then  ' check if year needs to change
            y = y - 1
        End If
        
        ws.Cells(o, 1) = DateSerial(y, m, d)  ' create a real numeric date and write it to the cell
        
        ' if the date needs to show in another format just change the numberformat to whatever you need
        'ws.Cells(o, 1).NumberFormat = "dd-mm-yyyy"
    Next o
End Sub
  •  Tags:  
  • Related