I'm very new to writing Macros in Excel, and have done a bit of looking around to try and solve my problem, but I haven't found a solution yet that works.
I'm trying to write a Macro to do the following:
Copy data from Source A (sheet Daily_Inventory(m3), workbook Daily_Inventory_YYYYMMDD) based on column headings (so for example, I want to copy all the data under the column name "All activities").The number of rows of data in this row may increase/decrease.
And then I want to paste this data into Destination B (sheet Daily_Inventory(m3), workbook Daily_Inventory_Master) under the corresponding column name "MMDDYYYY".
The workbook Daily_Inventory_YYYYMMDD will be stored in my specify folder everyday in 365 days, then I have to copy information from it to another workbook with every single related column header daily. If column header is not exist, add new value (same datetime as source file) then paste.
Please help me in this case, I'd be extremely grateful for any help.
Many thanks!!!
This is all done in my head and not tested, but it shouldn't be far away:
bookName1 = "Daily_Inventory_YYYYMMDD.xlsx"
sheetName1 = "Daily_Inventory(m3)"
headerRow1 = 8
bookName2 = "Daily_Inventory_Master.xlsm" 'note, xlsm as the macro would need to reside somewhere, better in the book you are using every day
sheetName2 = "Daily_Inventory(m3)"
headerRow2 = 12
DestHeader = mid(bookName1,20,2) & mid(bookName1,22,2) & mid(bookName1,16,4)
'Parsing the input date, play around with the numbers or use len(bookName1)-X, Y Z to work backwards if the first part of the name changes
'Oops, forgot to open the workbooks
Workbooks.Open "C:\folderName1\" & bookName1
Workbooks.Open "C:\folderName2\" & bookName2
'1. Find the source column
iCol = 1
DoUntil Workbooks(bookName1).Sheets(sheetName1).cells(headerRow1, iCol) = "All activities")
iCol = iCol + 1
Loop
'2. Find the last row for data within that column
lastRow = Workbooks(bookName1).Sheets(sheetName1).cells(1048576,iCol).End(xlUp).Row
'3. Copy the data
Range(Workbooks(bookName1).Sheets(sheetName1).cells(headerRow1+2,iCol), _
Sheets(Workbooks(bookName1).sheetName1).cells(lastRow,iCol)).Copy
'4. Use variation of step 1 to find the destination column
iiCol = 1
DoUntil Workbooks(bookName2).Sheets(sheetname2).cells(headerRow2,iiCol) = DestHeader
iiCol = iiCol + 1
Loop
'5. Paste data in
Workbooks(bookName2).Sheets(sheetname2).cells(headerRow2+2,iiCol)._
PasteSpecial Paste:=xlPasteValues
'Close the books
Application.DisplayAlerts = False 'Disable the popups asking for confirm for saving
Workbooks(bookName1).close saveChanges:=False
Workbooks(bookName2).close saveChanges:=True
Application.DisplayAlerts = True
Further to the above, if this was going to run daily, you could automatically get todays date and use it using
currDay = Format(Date, "dd")
currMonth = Format(Date, "mm")
currYear = Format(Date, "yyyy")
so bookName1 & DestHeader would be:
bookName1 = "Daily_Inventory_" & currYear & currMonth & currDay & ".xlsx"
DestHeader = currMonth&currDay&CurrYear
Related
I am posting here again and need very much working and specific codes for making a VBA macro for copying some specific cells from one worksheet to another using one button.
Here you can see my current invoice format -
And here is the Database sheet -
Problem here is - Using the New Invoice button, I want to move to a new invoice while the data from specific cells, Invoice#, Order#, Sale#, Date#, Client's Name, Subtotal, Order Type, will be copied or moved from Invoice sheet to Database sheet. Also, the contents of these cells will be cleared as well.
I have the code for clearing contents and adding new invoice number -
Sub NewInvoice()
Range("H8").Value = Range("H8").Value + 0.00001
Range("D8:D10").ClearContents
Range("C13:C23").ClearContents
Range("H9:H10").ClearContents
Range("H25:H27").ClearContents
UserForm1.Show
End Sub
I need to add the codes for copying data from one worksheet to another worksheet inside this same code, for the specific cell data.
I hope I could explain my situation here.
Waiting for your reply and thank you for your time and consideration.
With regards
Imran
This should do it...
Sub moveData()
Dim db_next_row As Long
Dim invoice_n, order_n, sales_n, date_n As String
Dim c_name, subtotal, order_type As String
'CONFIG HERE
'set the location of the cells in the invoice sheet
'------------------------------------------
invoice_n = ""
order_n = "" 'example: order_n = "B3"
sales_n = ""
date_n = ""
c_name = ""
order_type = ""
subtotal = ""
'-----------------------------------------
db_next_row = Sheets("Database").Cells(Rows.Count, 2).End(xlUp).Row + 1
'move info to database
With Sheets("Database")
.Range("B" & db_next_row) = Sheets("Invoice").Range(date_n)
.Range("C" & db_next_row) = Sheets("Invoice").Range(c_name)
.Range("D" & db_next_row) = Sheets("Invoice").Range(invoice_n)
.Range("E" & db_next_row) = Sheets("Invoice").Range(order_n)
.Range("F" & db_next_row) = Sheets("Invoice").Range(sales_n)
.Range("G" & db_next_row) = Sheets("Invoice").Range(subtotal)
.Range("H" & db_next_row) = Sheets("Invoice").Range(order_type)
End With
'clear content in the invoice
With Sheets("Invoice")
.Range(date_n).ClearContents
.Range(c_name).ClearContents
.Range(invoice_n).ClearContents
.Range(order_n).ClearContents
.Range(sales_n).ClearContents
.Range(subtotal).ClearContents
.Range(order_type).ClearContents
End With
End Sub
I've got an excel doc with 2 tabs. A data tab and a template tab. The data tab contains data in chunks equally spaced apart starting in row 52 (for this situation there's only three chunks). I want my code to copy some cells (the ones in gold) and paste it into the template tab. Then duplicate the template tab in another workbook to be saved and closed. Then it would go back to the original workbook and do the next chunk of data in the data tab till the end of all possible data (which will vary week over week, so like next week there could be 10 chunks).
Without the 'make new workbook and save' part of the code I can see it properly copy-pasting/cycling through to the end on my Template tab. So if it's plain like this, the data on the Template tab when done it's exactly the same as the last data set in the Data tab (aka the third chunk of the three total chunks of data with France + Nice). But when I add the new workbook+save feature it will properly do the 1st data chunk but then rapidly spirals into generating a bunch of empty excel docs that I have to ESC out of or will will never stop making them.
Dim i As Long, lastRow As Long
Set fnc = Sheets("France")
Set st = Sheets("Template")
lastRow = fnc.Cells(Rows.Count, "B").End(xlUp).Row
For i = 52 To lastRow
st.Range("B30").Value = fnc.Range("B" & i).Value
st.Range("C30").Value = fnc.Range("C" & i).Value
st.Range("D33").Value = fnc.Range("D" & i + 3).Value
st.Range("E33").Value = fnc.Range("E" & i + 3).Value
st.Range("F33").Value = fnc.Range("F" & i + 3).Value
st.Range("G33").Value = fnc.Range("G" & i + 3).Value
st.Range("H33").Value = fnc.Range("H" & i + 3).Value
Sheets("Template").Select
Sheets("Template").Copy
Sheets("Template").Name = "True Template"
If Dir("C:\Users\Edamame\Desktop\True Template", vbDirectory) = "" Then
MkDir ("C:\Users\Edamame\Desktop\True Template")
End If
ChDir ("C:\Users\Edamame\Desktop\True Template") ' Makes it save to the folder
Filename = "FW" & Format(Date, "ww") & "_" & Range("D30") & "_" & Range("B30") & "_True Template_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close False
Windows("Wine.xlsb").Activate
Next i
As per my comment:
Seems to me you are using empty cells to populate B30 and C30 if you go from 52 to lastRow. Try to include a Step 10 and check if that would work.
For i = 52 To lastRow Step 10
I have two workbooks. One workbook has the calendar dates(Calendar.xlsm) and the other workbook has only the names(Workingdays.xlsm) of my class students. What i'm trying to do is to match the names in Workingdays.xlsm to Calendar.xlsx . If the match is found then copy the entire row (last filled cell) to Workingdays.xlsm.
So far i'm successful in matching the names in the two workbooks but unable to select the entire row for that matched names.
Sub Obtain_days()
' Open Calendar
Dim calendar_wb As Workbook
Dim calendar_ws As Worksheet
Dim Workdays_ws As Worksheet
Set calendar_wb = Workbooks.Open("C:\Users\XXX1\Desktop\Calendar.xlsx")
Set calendar_ws = calendar_wb.Worksheets("Sheet1")
Set Workdays_ws = Workbooks("Workingdays.xlsm").Worksheets("Sheet1")
' obtain dates
Workdays_ws.Activate
last_rw_Workdays = Workdays_ws.Range("A1000000").End(xlUp).Row
last_rw_calendar = calendar_ws.Range("A1000000").End(xlUp).Row
'last_col_calendar = calendar_ws.Range("XFD3").End(xlToLeft).Column
' loop through names <-------------Sucessful in matching names
For i = 3 To last_rw_Workdays
findval = Workdays_ws.Range("A" & i).Value
For j = 5 To last_rw_calendar
If calendar_ws.Range("A" & j).Value = findval Then
'calendar_ws.Range("C" & last_col_calendar).Copy
calendar_ws.Cells(j, 32).Resize(1, 25).Copy Destination:=Workdays_ws.Cells(i, 3).Resize(1, 2) '<---failed in this step, copying irrelevant cell reference
'ActiveSheet.Range((last_rw_calendar, 1),(last_rw_calendar, last_col_calendar)).Copy
Workdays_ws.Activate
'Workdays_ws.Range("B1000000").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next j
Next i
End Sub
Failed to copy the entire row (Till last filed cell). Any help would be much appreciated
Without more details, I believe you actually want:
calendar_ws.Cells(j, 1).Resize(1, 25).Copy Destination:=Workdays_ws.Cells(i, 3)
This is assuming the "calendar_ws" row has 25 columns you want to copy over to "Workdays_ws" starting in column "C".
I was tasked with creating a code that will check to see if internal hyperlinks in an excel spreadsheet worked. This code first changes the formulas that were on the spreadsheet and makes them actual hyperlinks (they were originally formulas linking the locations together). The problem that I have now is that I want to create hyperlinks ONLY if Column S has text. If it doesn't, I don't want the "E-COPY" text to be displayed. All of the text in Column S varies (not one line has the same characters), which is why I'm drawing a blank is to how I tell the program to only continue if it has any text, not anything specific. I am working with Excel 2016.
Also, I am doing this to 71935 and counting rows; is there a limit to how many it can go through? If so, what can I do about it?
Thank you!
Sub CreateHyperlinks()
Dim FN As Variant
Dim Path As Variant
Dim count As Variant
Sheets(1).Activate
count = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
For i = 2 To count
If Range("AM" & i).Value = "Yes" And Columns("S") = Then
Range("E" & i).Value = ""
Path = Sheets(1).Range("R" & i).Value
FN = Sheets(1).Range("S" & i).Value
Sheets(1).Range("E" & i).Select
Selection.ClearFormats
Selection.Hyperlinks.Add Anchor:=Selection, Address:=Path & FN, TextToDisplay:="E-COPY"
Range("AM" & i).Value = " "
End If
Next i
End Sub
If you just need to check for any content in ColS then:
If Range("AM" & i).Value = "Yes" And Len(Range("S" & i).Value) > 0 Then
Few things:
'make a reference to the sheet you're working with
Dim ws As Worksheet
Dim wb As Workbook
Set wb = Excel.Application.ThisWorkbook
Set ws = wb.Worksheets(1)
'gets the absolute last row with data in it // ignores empty cells
count = ws.UsedRange.Rows.Count
personally, i hate working with named ranges, so i would suggest setting range references like so
what you wrote
Path = Sheets(1).Range("R" & i).Value
what i believe it should look like
Path = ws.Cells(i, 18).Value
if you want to test the type when working with variants, try this:
'tests the type associated with the variant. an 8 = string
If VarType(ws.Cells(i, 19).Value) = 8 Then
'do your thing
'tests if the value is null
ElseIf VarType(ws.Cells(i, 19).Value) = 0 Then
'do your other thing
here's a list of the vartype enumeration to help you out.
hope it helps!
I have a simple macro created to consolidate the files one below the other (i.e., find the last line and paste the next data)
So On a daily basis according to the date I need to consolidate the data (for a month - 30days)
My file is saved in the Path- I:\Tracker\2017\May'17
File Name : Signoff Sheet_May_01 (This date May 01 everyday according to the calendar date)
The File Path and the date I have a sheet created named KPI and entered the details in there,
My code as follows :
Sub KPI()
Set thiwkb = ThisWorkbook.Worksheets("KPI")
Mydate = thiwkb.Range("B2")
Set destsheet = ThisWorkbook.Sheets("Production")
Path = thiwkb.Range("B3") & "\" & "Signoff Sheet_" & Mydate & ".xlsx"
Irow = 1
Irow1 = 1
Irow2 = 1
Set wkb = Workbooks.Open(Path)
wkb.Worksheets("Daily tracker").Range("A1").CurrentRegion.Copy Destination.Range("A" & Irow)
wkb.Close False
Irow = destsheet.Range("a1").CurrentRegion.Rows.Count + 1
End Sub
My Code is pulling the data however when I change the data in the KPI sheet everyday i need the data to be consolidated or pasted according to the date.