Rolling Weeks

[tljenkin]

Hi All

I have a database that I update every week with about 300 new records. The first column is the week column and this will change each week eg week 10, all records will be be week 10, week 11 will have week 11 and so on.

How do I get vba after pasting the records to automatically populate the first column (week) with the next weeks name eg following on from above, next week would be week 12

I am guessing I need to find the last row in column a after pasting, look at the cell above, check the last 1,2 or 3 digits (should be dynamic) and add one and then merge the result with "week". Then fill down in current region

Just not sure how to code it, please help

Thanks

 

[Jerry Sullivan]

Hi,

You can modify this to increment the week string after finding the last week.

Sub NextWeek_Example ()
    Dim strLastWeek As String, strThisWeek As String
    strLastWeek = "Week 11"
    strThisWeek = "Week " & Split(strLastWeek, " ")(1) + 1
    MsgBox strThisWeek
End Sub

 

[tljenkin]

Thanks but I want it to be dynamic. If I hard code week 11 into the code I am stuck. I want the code to detect the last week, add one and give me the next weeks name. Then select current region and paste.

Hi,

You can modify this to increment the week string after finding the last week.

Sub NextWeek_Example ()
    Dim strLastWeek As String, strThisWeek As String
    strLastWeek = "Week 11"
    strThisWeek = "Week " & Split(strLastWeek, " ")(1) + 1
    MsgBox strThisWeek
End Sub

 

[tljenkin]

Eg

Week Data

Week 11 x
Week 11 y
Week 11 z

Need the code to change to week 12 and fill next 3 rows (assuming there are only 3 records to paste)

Thanks but I want it to be dynamic. If I hard code week 11 into the code I am stuck. I want the code to detect the last week, add one and give me the next weeks name. Then select current region and paste.

 

[Jerry Sullivan]

Yes, I understood that you want this to be dynamic,
I was only showing you an example of the one step to increment the week.

The full code could look something like this...

Sub FillNextWeek()
    Dim strLastWeek As String, strThisWeek As String
    Dim lLastRowColA As Long, lLastRowColB As Long
    
    '---get last row of Columns A and B
    lLastRowColA = Range("A" & Rows.Count).End(xlUp).Row
    lLastRowColB = Range("B" & Rows.Count).End(xlUp).Row
    If lLastRowColA = lLastRowColB Then Exit Sub
    
    '---increment last week by 1 to make string for this week
    strLastWeek = Range("A" & lLastRowColA).Value
    strThisWeek = "Week " & Split(strLastWeek, " ")(1) + 1
    
    '---fill in Col A for this week's records
    Range(Range("A" & lLastRowColA + 1), _
        Range("A" & lLastRowColB)).Value = strThisWeek
End Sub

 

[tljenkin]

One more question, what if there was no space between the week and week number, eg week55, how would you change the code to reflect this?

Thanks

 

[Jerry Sullivan]

You could use this statement instead....

strThisWeek = "Week" & Mid(strLastWeek, 5) + 1

 

[tljenkin]

Thanks for this, on its own it runs fine but when I try and make it run within the code below, I get a type mismatch error.

Also could you adjust the check that compares last row in a and b as the exit sub stops the rest of the code running.

I need to add your code in 2 places, see below. I have marked it with

'WOULD LIKE TO ADD YOUR CODE RIGHT HERE




Thanks

=====

Sub UpdateDatabase()

Dim FileToBeOpened As Variant, File As Variant, Ard As Workbook, Wrr As Workbook
Set Ard = ThisWorkbook ' or Actuals repository current version presently open

Application.ScreenUpdating = False

Dim Response As Integer
Response = MsgBox(prompt:="Is the most recent weekly Redress report open?", Buttons:=vbYesNo)
If Response = vbYes Then
On Error GoTo 0


For Each Wrr In Application.Workbooks
If Wrr.Name Like "Week*" Then Wrr.Activate
Next Wrr
Set Wrr = ActiveWorkbook
Wrr.Activate
Sheets("Tracking Report").Select
Application.Goto Reference:="R5C2:R500C38"
Selection.Copy

'Define the final row
Ard.Activate
Sheet13.Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
NextRow = FinalRow + 1
Cells(NextRow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'WOULD LIKE TO ADD YOUR CODE RIGHT HERE


Calculate
ActiveWorkbook.RefreshAll
Sheet22.Activate
Wrr.Close (False)
Application.ScreenUpdating = True

End If


If Response = vbNo Then


On Error GoTo 0
FileToBeOpened = Application.GetOpenFilename(FileFilter:="All Excel Files (*.xls*), *.xls*", Title:="Where is the most recent weekly Redress file?", MultiSelect:=False)
Application.ScreenUpdating = False

' Exit if user exits dialog
If FileToBeOpened = False Then Exit Sub

' Open file (Wrr), copy most recent weekly redress data to the Actuals Repository
Set Wrr = Workbooks.Open(FileToBeOpened)
Wrr.Activate
Sheets("Tracking Report").Select
Application.Goto Reference:="R5C2:R500C38"
Selection.Copy

'Define the final row
Ard.Activate
Sheet13.Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
NextRow = FinalRow + 1
Cells(NextRow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False


'WOULD LIKE TO ADD YOUR CODE RIGHT HERE


Calculate
ActiveWorkbook.RefreshAll
Wrr.Close (False)
Application.ScreenUpdating = True

End If

End Sub

 

[tljenkin]

also is there a way to loop my code to the first section so i dont have to paste it twice like above?

thanks

 

[Jerry Sullivan]

Thanks for this, on its own it runs fine but when I try and make it run within the code below, I get a type mismatch error.

If you are getting that error, it means that the last value in Column A doesn't fit your pattern of "Week###".

The revision below will help, it could be further extended by checking that the last part is numeric, but you probably don't need to bog down the code with things that are easily controlled in the worksheet.

Sub FillNextWeek()
    Dim strLastWeek As String, strThisWeek As String
    Dim lLastRowColA As Long, lLastRowColB As Long
    
    '---get last row of Columns A and B
    lLastRowColA = Range("A" & Rows.Count).End(xlUp).Row
    lLastRowColB = Range("B" & Rows.Count).End(xlUp).Row
    If lLastRowColA = lLastRowColB Then Exit Sub
    
    '---increment last week by 1 to make string for this week
    strLastWeek = Range("A" & lLastRowColA).Value
    If Left(strLastWeek, 4) = "Week" Then
        strThisWeek = "Week" & Mid(strLastWeek, 5) + 1
    Else
        MsgBox "Error: Last Cell in Col A is: " & strLastWeek
    End If
    '---fill in Col A for this week's records
    Range(Range("A" & lLastRowColA + 1), _
        Range("A" & lLastRowColB)).Value = strThisWeek
    
End Sub

As for your other questions and requests, best to start a new thread for those.

Good luck!