VBA code required to create a Macro in Excel

Question

I am working on a spreadsheet one element of which requires a repetitive copy/paste from current column into next column, then copy/paste values back into the first column. The columns in the worksheet contain figures for each working day of the year.

The idea being to keep moving the formula along from yesterday's column into today's column. This is part of a process carried out each morning before starting to input today's data into the worksheet.

Ideally the formula would always be in today's column but the data in yesterday's column should be pasted back in as special values.

I need a macro to streamline the process.

Example:

1. Copy data range BM53:BM146
2. Paste into BN53:BN146
3. Copy data range BM53:BM146
4. Paste Special Values back into BM53:BM146

Next morning when I run the macro it should then

1. Copy data range BN53:BN146
2. Paste into BO53:BO146
3. Copy data range BN53:BN146
4. Paste Special Values back into BN53:BN146

And so on each day.

I found the code below through online searches. The code is for rows down the spreadsheet. I tried to rework it for my need which is columns across the spreadsheet but got into a mess.

Code:

Sub AddToNextRow() 
    Dim Count, LastRow As Integer 
    LastRow = Cells(35536, 3).End(xlUp).Row 
    For Count = 3 To 22 
        ActiveSheet.Cells(LastRow + 1, Count).Formula = ActiveSheet.Cells(LastRow, Count).Formula 
        ActiveSheet.Cells(LastRow, Count) = ActiveSheet.Cells(LastRow, Count) 
    Next Count 
End Sub

Answer 1

The code you have found is rubbish. I suggest you do not visit the site where you got it again.

"35536" should have been "65536" but only if the code was posted before 2007. Until Excel 2007, the maximum number of rows in a worksheet was 65536. Since then you would be told to write Rows.Count which gives the number of rows per worksheet for the version of Excel being used.

---

The first task is to find the correct column. You could search from the column for 1-Jan-2015; for a macro that is only run once per day this would be acceptable. However, I have used function DatePart to find an approximate start column and have then searched backwards or forwards for the correct column. This is a bit OTT. I would normally recommend the minimum necessary to achieve the desired effect but I wanted to show you some of the possibilities.

The code you found uses ActiveSheet. This can be appropriate but rarely is. Using ActiveSheet relies on the user have the correct worksheet active when the macro is started. The macro will probably fail to find today’s date in the wrong sheet but it is better if your code explicitly references the correct worksheet.

Row 51 may be the row containing dates today but will it always be the correct row? I have made the row a parameter in a function call for the first block of code. Defining it as a constant is another option:

Const RowDate as Long = 51

I normally find using a constant the best approach for this type of problem. I have a list on constants at the top of my modules for rows, columns and anything else that is currently fixed but might change in the future. Should the value ever change, amending the constant definition is all that is necessary to fully update the macro.

I have set four rows in worksheet “Daily” to list of dates but with different start columns so I could test all the exist points from the function:

TestData

The code below output this to the Immediate Window:

Column in row 51 for today is 63=BK
Column in row 41 for today is 64=BL
Column in row 44 for today is 66=BN
Column in row 47 for today is 60=BH

Option Explicit
Sub TestFindColToday()

  Dim ColToday As Long

  ColToday = FindColToday("Daily", 51)
  Debug.Print "Column in row 51 for today is " & ColToday & "=" & ColNumToCode(ColToday)
  ColToday = FindColToday("Daily", 41)
  Debug.Print "Column in row 41 for today is " & ColToday & "=" & ColNumToCode(ColToday)
  ColToday = FindColToday("Daily", 44)
  Debug.Print "Column in row 44 for today is " & ColToday & "=" & ColNumToCode(ColToday)
  ColToday = FindColToday("Daily", 47)
  Debug.Print "Column in row 47 for today is " & ColToday & "=" & ColNumToCode(ColToday)

End Sub
Function FindColToday(ByVal WshtName As String, RowDate As Long) As Long

  Dim ColToday As Long
  Dim Today As Date

  Today = Date
  ColToday = DatePart("y", Today) * 5 / 7

  With Worksheets(WshtName)

    If .Cells(RowDate, ColToday).Value = Today Then
      ' Have found Today
      FindColToday = ColToday
      Exit Function
    ElseIf .Cells(RowDate, ColToday).Value > Today Then
      ' This column is after the column for Today
      ' Move back until correct column found or does not exist
      Do While True
        ColToday = ColToday - 1
        If .Cells(RowDate, ColToday).Value = Today Then
          ' Have found Today
          FindColToday = ColToday
         Exit Function
        ElseIf .Cells(RowDate, ColToday).Value < Today Then
          ' Today is not present in row
          Debug.Assert False
          ' Add appropriate code
        End If
      Loop
    Else
      ' This column is before the column for Today
      ' Move forward until correct column found or does not exist
      Do While True
        ColToday = ColToday + 1
        If .Cells(RowDate, ColToday).Value = Today Then
          ' Have found Today
          FindColToday = ColToday
         Exit Function
        ElseIf .Cells(RowDate, ColToday).Value > Today Then
          ' Today is not present in row
          Debug.Assert False
          ' Add appropriate code
        End If
      Loop
    End If
  End With

End Function
Function ColNumToCode(ByVal ColNum As Long) As String

  Dim Code As String
  Dim PartNum As Long

  ' Last updated 3 Feb 12.  Adapted to handle three character codes.
  If ColNum = 0 Then
    ColNumToCode = "0"
  Else
    Code = ""
    Do While ColNum > 0
      PartNum = (ColNum - 1) Mod 26
      Code = Chr(65 + PartNum) & Code
      ColNum = (ColNum - PartNum - 1) \ 26
    Loop
  End If

  ColNumToCode = Code

End Function

---

I think what you are doing is copying formats, values and formulae forward one column then overwriting the formulae in the yesterday’s columns with their values. If I am wrong, I believe there is enough information for you to adjust the macro to your exactly requirements. Come back with questions as necessary but the more you can do yourself, the faster you will develop.

Sub CopyYesterdayToTodayAndFixYesterday()

  ' "Yesterday" is the last working day before today. For Tuesday to
  ' Friday this will be yesterday. For Monday it will Friday. This will
  ' not be true if columns are omitted for public holidays.

  Const RowDate As Long = 51
  Const RowCopyFirst As Long = 53
  Const RowCopyLast As Long = 146
  Const WshtTgtName As String = "Daily"

  Dim ColToday As Long
  Dim RngSrc As Range

  ColToday = FindColToday("Daily", 51)

  With Worksheets(WshtTgtName)

    Set RngSrc = .Range(.Cells(RowCopyFirst, ColToday - 1), .Cells(RowCopyLast, ColToday - 1))
    Debug.Print RngSrc.Address

    ' Copy yesterday's formats, values and formulae to today
    RngSrc.Copy Destination:=.Cells(RowCopyFirst, ColToday)

    ' Overwrite yesterday's formulae with value
    RngSrc.Value = RngSrc.Value

  End With

End Sub

Answer 2

It seems you want to copy your formulas from the last used column into a new column then revert the formulas in the original to their values.

with activesheet.cells(53, columns.count).end(xltoleft).resize(94, 1)
    .copy destination:=.offset(0, 1)
    .value = .value
end with

You should be able to run that daily to generate new columns of formulas to the right. I'm using a set number of rows but those could be adjusted daily as well if it was known what changed them.