I do have a workbook where multiple sheets are named based on date (in format MMDDD). This macro should loop trough all date sheet (like 01OCT, 02OCT, .... 30OCT) select range and copy it into new sheet.
Selecting cells, copying them and so is not really problem, and that is working perfectly. However I do have a problem defining sheet name. I would like user in the beginning define month and number of days in month and month using InputBox.
So if user select month = "FEB" and DaysMonth = 28, I would like macro to loop trough sheets named 01FEB, 02FEB, 03FEB, .... 28FEB.
Sub Merge_whole_month()
Application.ScreenUpdating = False
Dim month As String
month = InputBox(Prompt:="Please enter month in format MMM", _
Title:="Month")
Dim DaysMonth As Long
DaysMonth = InputBox(Prompt:="Please enter number of days in month", _
Title:="Days")
'create new sheet for results
Sheets.Add.Name = "Merge"
'loop
For i = 1 To DaysMonth
i = Format(i, "##")
Sheets(i & month).Activate 'here is the problem
'select cell G3, then all "non-empty" cells to the right and down and COPY
Range(Range("G3", Range("G3").End(xlToRight)), Range("G3", Range("G3").End(xlToRight)).End(xlDown)).Select
Selection.Copy
Sheets("Merge").Activate 'activate sheet where cells needs to be copied
'find last cell in 2nd row in sheet
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
lastCol = lastCol + 1
Cells(1, lastCol) = i & month 'log date and month in cell above
Cells(2, lastCol).Select
ActiveSheet.Paste 'Paste
Next i
Application.ScreenUpdating = True
End Sub
Many thanks in advance for any help!
The problem lies in the facto that i = Format(i, "##") does not make i less than 10 appear as 01 etc. To fix this i would do this:
Dim sDate As String
sDate = CStr(i)
If Len(sDate) < 2 Then
sDate = "0" & sDate
End If
Place that code within your for-loop before Sheets(i & month).Activate and remove i = Format(i, "##").
EDIT:
It also seems that for me using Format(i, "0#") gives the string you were looking for. However you will still need to assign this to a String variable or change Sheets(i & month).Activate to Sheets(Format(i, "0#") & month).Activate.
Here is the documentation on the Format() function. I suggest reading it.
Related
I am working with date data and want to autofill to a specific date. The specific date will be stored as value X. X is the last value in column A
I've looked at some other posts here on StackOverflow, but the issue I keep running into is setting my final "value". My final value will not be a number, but a date to stop at.
With ThisWorkbook.Sheets("Form Date 2")
'Select this workbook
Dim X as Date
'I am not sure what I need to Dim this as
Range("B2").Value = Range("A2").Value
'B2 is the value I want to autofill down with
X = Range("A" & Rows.Count).End(xlUp).Value
'X will be the last value in column A
Range("B2").Autofill Destination:=Range("B2:B" & X), Type:=xlFillSeries
'Not sure what to set my Type as
End With
So the final result would be, Column B would obtain all dates from A1 to last value in A (02/04/2018-05/06/2018). Format should be dd/mm/yyyy.
In Column A I have a whole bunch of dates, but some are missing, so I am grabbing all the missing ones as well.
With the picture below I have the Dates column. I want VBA to spit out the All Dates column. So The code will copy and paste A2 over to B2 and then autofill until the last value in column A(not row). So in this example All Dates should continue down until value/date 01/06/2018.
Perhaps this will work:
With ThisWorkbook.Sheets("Sheet2")
'Select this workbook
Dim X As Integer
'I am not sure what I need to Dim this as
.Range("B2").Value = .Range("A2").Value
'B2 is the value I want to autofill down with
X = .Range("A" & .Rows.Count).End(xlUp).Row
'X will be the last value in column A
.Range("B2").Select
Selection.AutoFill Destination:=.Range("B2:B" & X), Type:=xlFillDefault
'Not sure what to set my Type as
End With
Updated Code to fill till the date on the last cell of Column A:
With ThisWorkbook.Sheets("Sheet2")
'Select this workbook
Dim X As Integer
'I am not sure what I need to Dim this as
.Range("B2").Value = .Range("A2").Value
'B2 is the value I want to autofill down with
X = .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value - .Range("B2").Value
'X will be the last value in column A
.Range("B2").Select
Selection.AutoFill Destination:=.Range("B2:B" & X + 2), Type:=xlFillDefault
'Not sure what to set my Type as
End With
This code works fine :
Sub test()
Dim X As Integer
ThisWorkbook.Sheets("Sheet2").Range("B2").Value = Range("A2").Value
'B2 is the value I want to autofill down with
X = ThisWorkbook.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
'X will be the last value in column A
ThisWorkbook.Sheets("Sheet2").Range("B2").AutoFill Destination:=ThisWorkbook.Sheets("Sheet2").Range("B2:B" & X), Type:=xlFillDefault
End Sub
You're welcome :)
I have an invoice template sheet in invoice workbook that i want to save some of its fields in an other workbook "Excel data only", sheet "invoices". When creating an invoice i want to get the last invoice number from the "Excel data only", "Invoices" sheet column A and then add 1 to it.
Note that the invoice number has the format ST00001.
After that i want to save the invoice number in the workbook excel data only with its details: C10,C11 and C12 which represent the total.
I don't know how to do it since i am new in vba this is what i tried to do but not working.
Dim v As Workbook
Set v = Workbooks("Excel data only")
Range("I12").Value = v.Sheets("INVOICES").Cells(v.Sheets("INVOICES").Rows.Count, "A").End(xlUp).Row.Value + 1
Sounds like
Dim v As Workbook, cellValue As String
Set v = Workbooks("Excel data only")
With v.Worksheets("INVOICES")
cellValue = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
ActiveSheet.Range("I12").Value = "ST" & Format$((Right$(cellValue, 5) + 1), "00000")
Sub test_1()
Dim v As Workbook, cellValue As String
With Worksheets("sheet2")
cellValue = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
ActiveSheet.Range("B13").Value = "" & Format$((Right$(cellValue, 2) + 1), "")
End Sub
these codes increment by going to last row number, with increment can you write these codes that can search if any number missing in between invoice it should show that also. for example invooice from 1 to 10 and 7 number is missing so instead of last row number increment it should give me missing number.
thnx
I'm trying to update a date and simultaneously record each individual date and its respective z score on a separate worksheet. My excel file is is already set up so that as the date changes, the corresponding z scores for the day updates. Can anyone help me write VBA code that compiles the date with corresponding data for each day within the date range? Ideally, I want the code to adjust for a start date and end date when it is changed directly on the excel sheet. Unfortunately, I can't seem to update the date by one day without presetting it to a specific day, as an objected required error occurs for the "nextday" part of the code.
Sub compliedataloop()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim wsprecip As Worksheet
Set wsprecip = wb.Worksheets("Precip")
Dim wshistoricaldata As Worksheet
Set wshistoricaldata = wb.Worksheets("Historical Data")
Dim nextday As String
Set nextday = wb.wsprecip.Range("CJ4")
wb.wshistoricaldata.Range("C4").Activate
wb.wsprecip.Range("CJ4").Activate
ActiveCell.Copy
wb.wshitoricaldata.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(1, 0).Activate
wb.wsprecip.Range("CN37").Activate
ActiveCell.Copy
wb.wshistoricaldata.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(-1, 1).Activate
wb.wsprecip.Range("CJ4").Activate
nextday.DateAdd = ("d")
Do While Enddate = False
'select, copy and paste first Date from cell CJ5 in "precip" Worksheet to "historicaldata" worksheet
wb.wsprecip.Range(CJ4).Activate
ActiveCell.Copy
wb.wshistoricaldata.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(1, 0).Activate
wb.wsprecip.Range("CJ4").Activate
nextday.DateAdd = ("d")
'copy new z-score for new date and paste data into "historicaldata" worksheet
wbs.wsprecip.Range("CN37").Activate
ActiveCell.Copy
wb.wshistoricaldata.Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.PasteSpecial
'reset positioning for next day's date in one cell above and to the right
ActiveCell.Offset(-1, 1).Activate
If Enddate = 2 / 28 / 2018 Then
Enddate = True
End If
End Sub
I don't know where to begin...
Make sure that you have Option Explicit as the first line in the module. It will require you to define all of your variables, which stops you from randomly mistyping (wbs) or using variables (Enddate) that haven't been assigned a value.
PS please you capital letters at the start of each word in variable names, so that you can read them easier i.e. NextDay
You defined nextday as a string. A string is not an object, hence why the " object required error occurs".
If all that you are doing is adding a day, you don't need the DateAdd function, just add 1.
You don't need to use any .Activate, .copy or .PasteSpecial to just copy a value from one cell to another.
I can't exactly figure out what you are doing; specifically with your end date. Are you trying to make this run once a day and keep writing to the next column? If so, you need to fine the last column with something like this:
Public Function LastColumn(Optional Row As Integer = 1, Optional Sheet As Excel.Worksheet) As Long
If Sheet Is Nothing Then Set Sheet = Application.ActiveSheet
LastColumn = Sheet.Cells(Row, Sheet.Columns.Count).End(xlLeft).Row
End Function
Set cell to the empty cell (Offset) after the last cell in row 4:
Set cell = LastColumn(4, wb.wsHistoricalData).offset(0,1)
Anyway, here is what your code roughly looks like when fixed...
Option Explicit
Sub ComplieDataLoop()
Dim wb As Workbook
Dim wsPrecip As Worksheet
Dim wsHistoricalData As Worksheet
Dim NextDay As Date
'Dim EndDate As Date???
Dim cell As Range
Set wb = ActiveWorkbook
Set wsPrecip = wb.Worksheets("Precip")
Set wsHistoricalData = wb.Worksheets("Historical Data")
NextDay = wb.wsPrecip.Range("CJ4")
'EndDate = ???
Set cell = wb.wsHistoricalData.Range("C4")
Do While EndDate < DateSerial( 2018, 2, 28)
cell = wb.wsPrecip.Range("CJ4")
Set cell = Offset(-1, 0)
cell = wb.wsPrecip.Range("CN37")
'reset positioning for next day's date in one cell above and to the right
Set cell = Offset(-1, 1)
'EndDate = ???
Loop
End Sub
I have two workbooks.
Workbook A
Supplier Name Date
Supplier A Jun-17
Supplier B Jun-17
Supplier C May-17
Workbook B
Supplier Name
Supplier A
Supplier B
I am trying to copy all supplier names where they match the date Jun-17.
Jun-17 is written on a sheet called (assets) in cell B1.
I am getting an error
Object doesn't support this property or method.
On this line:
If ThisWorkbook.Worksheets(1).Format(Range("O" & j).Value, "mmm") = ThisWorkbook.Worksheets("assets").Range("b1").Value Then
My code:
Sub Monthly()
On Error Resume Next
UserForm1.Show
If Format(Range("O211").Value, "mmm") = Worksheets("assets").Range("b1").Value Then
MsgBox "Yes"
End If
Dim WB As Workbook
On Error Resume Next
Set WB = Workbooks("PAI Monthly Audits.xlsx")
On Error GoTo 0
If WB Is Nothing Then
Set WB = Workbooks.Open("G:\QUALITY ASSURANCE\03_AUDITS\PAI\templates\PAI Monthly Audits.xlsx", UpdateLinks:=False)
End If
With ThisWorkbook.ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
j = 6
For i = 2 To LastRow
If ThisWorkbook.Worksheets(1).Format(Range("O" & j).Value, "mmm") = ThisWorkbook.Worksheets("assets").Range("b1").Value Then
.Range("B" & i).Value = ThisWorkbook.Worksheets(1).Range("B" & j).Value
j = j + 1
End If
Next i
End With
End Sub
Please can someone show me where I'm going wrong?
Try it like this...
If Format(ThisWorkbook.Worksheets(1).Range("O" & j).Value, "mmm") = ThisWorkbook.Worksheets("assets").Range("b1").Value Then
The runtime error can be corrected with the suggestions already made (the ThisWorkbook.Worksheets(1) should used to identify the parent of Range("O" & j), not of Format) but that doesn't mean your code will work. As a true date, 17-Jun-2017 has a raw value of 42,903. Format(42903, "mmm") returns "Jun" as a text string. The text Jun does not equal 42903.
If both Assets!B1 and the dates in 'Workbook A' column O are true dates then you only have to compare their raw values 'to copy all supplier names where they match the date Jun-17'.
If ThisWorkbook.Worksheets(1).Range("O" & j).Value2 = ThisWorkbook.Worksheets("assets").Range("b1").Value2 Then
Beyond that, using AutoFilter to select all of the rows with 17-Jun-2017 dates would be more efficient. See Using cell values as a date range autofilter. Even using an INDEX/MATCH function pair to the closed workbook might be preferable.
I am working with Excel 2010.
I wish to convert a given date from the format mm/dd/yyyy to the format Wyy"weeknumber"
For example, 4/10/2017 would become W1715, since it is week 15 of 2017.
The below shown image is of the excel table I am working on. I want to convert the dates in column LT Verification - Planned Date to the week number format mentioned above, in column LT Verification - Planned Week Numbers.
Edit: Because this is part of a larger VBA process, I need it to be in VBA, not a cell formula.
I have written the following code:
Public Sub WeekNumbers()
Dim lastRow As Integer
lastRow = Range("A1:AZ1").Find("*", , , , xlByRows, xlPrevious).Row
Dim myRange As Range
Set myRange = Range("A1:AZ1" & lastRow)
Dim myCell As Range
For Each myCell In myRange
myCell.Offset(0, 1).Value = "W" & Right(Year(myCell.Value), 2) & Application.WorksheetFunction.WeekNum(myCell.Value)**
Next myCell
End Sub
This code gives me error at myCell.Offset(0, 1).Value = "W" & Right(Year(myCell.Value), 2) & Application.WorksheetFunction.WeekNum(myCell.Value)
Here I have a excel workbook which will be updated every week. So, each time it is updated, it runs a macro to import data from another file & perform the week number activity & create a pivot table.
So, the sheet name changes every week. Also, the column headers may be in different columns in different weeks. Also, the number of rows may also change every week.
So, I need to specify column & row range dynamically based on that weeks data.
And have the week numbers in the column based on the column header rather than the column name (A or B or Z...)
This can be achieved easily with a cell formula:
="W" & RIGHT(YEAR(A1),2) & WEEKNUM(A1)
Where A1 can be replaced by the cell containing the date.
In VBA this is equivalent to
With Thisworkbook.Sheets("Sheet1")
.Range("A2").Value = "W" & Right(Year(.Range("A1").Value), 2) & Application.WorksheetFunction.WeekNum(.Range("A1").Value)
End With
Edit:
To fill an entire range, you could loop over the cells, apply the VBA calculation as above.
Dim myRange as Range
Set myRange = Thisworkbook.Sheets("Sheet1").Range("A1:A10")
Dim myCell as Range
For Each myCell in myRange
myCell.Offset(0,1).Value = "W" & Right(Year(myCell.Value), 2) & Application.WorksheetFunction.WeekNum(myCell.Value)
Next myCell
There are many methods for finding the last row in a range, so I'll leave that to you if you don't know your range.
Edit 2: in response to your error edit.
You have used the following line to define your range:
Set myRange = Range("A1:AZ1" & lastRow)
Let's imaging you have lastRow = 20, you now have
myRange.Address = "A1:AZ120"
Which is clearly wrong, you shouldn't have the 1 after the AZ. Also I don't know why you've gone to column AZ, if all of your date data is in column A, you should use
Set myRange = Range("A1:A" & lastRow)
The loop you've implemented uses an offset, so the values in column B are changed to reflect those in column A. You can't then set column C according to column B!
In VBA, you can get your string by using the Format function. "\Wyyww" is the format you are looking for, where \ is used to escape the interpretation of the first W character and to take it as a litteral.
myCell.Offset(0,1).Value = Format(myCell.Value, "\Wyyww")
More
You have to setup correctly the range for your loop. If your dates are in some column with header "LT Verificiation - Planned Date", you can try this:
Dim ws As Worksheet
Set ws = ActiveSheet ' <-- you can change this into something explicit like Sheets(someIndex)...
Dim myCell As Range
Set myCell = ws.Rows(1).Find("LT Verificiation - Planned Date")
For Each myCell In ws.Range(myCell.Offset(1), ws.Cells(ws.Rows.Count, myCell.Column).End(xlUp))
If IsDate(myCell.value) Then myCell.Offset(, 1).value = Format(myCell.value, "\Wyyww")
Next myCell
I don't think you need VBA for this, try this formula:
=RIGHT(YEAR(A1),2)&WEEKNUM(A1)&"W"
Of course, if you insist on VBA, you can always turn Excel Formulas into VBA code. In this case:
Dim rngInput As Range
Dim rngOutput As Range
With Application.WorksheetFunction
rngOutput.Value = .Right(.Year(rngInput.Value), 2) & .Weeknum(rngInput.Value) & "W"
End With
Or you may even set the Formula, and Insert the Value, like this
Dim rngInput As Range
Dim rngOutput As Range
rngOutput.Formula = "=RIGHT(YEAR(" & rngInput.Address(False, False) & "),2)&WEEKNUM(" & rngInput.Address(False, False) & ")&""W"""
rngOutput.Value = rngOutput.Value