I am in the process of writing a macro that needs to be able add a number of rows based on COUNTIF formula.
=COUNTIF(D2:D1000,">=1/1/2017")-COUNTIF(D2:D1000,">1/2/2018")
So essentially, I want to be able to put that formula on my destination sheet, use the formula to count all the times that a date appears within the range in my source spreadsheet, return the count and add new rows based on what the value is. The formula is accurate, its just in the wrong place at the moment (it's on the source spreadsheet, not the destination). I have the start of some code but I am struggling with where to go next to achieve my goal. Can anyone please help?
Sub Map_To_Import_Sheet()
Dim wbs As Workbook 'Source workbook
Dim wbd As Workbook 'Destination workbook already open
Dim ss As Worksheet 'Source worksheet
Dim ds As Worksheet 'Destination worksheet
Set wbd = ThisWorkbook
Set wbs = Workbooks.Open("S:\Accounts (New)\Management Information
(Analysis)\Phil Hanmore - Analysis\Neil Test\TimeSheet Templates\Copy of
MSI shifts 19th June - 25th June.xlsx")
Set ss = wbs.Worksheets(1)
Set ds = wbd.Worksheets("Import Sheet")
'Removes the data from the columns A through R in NHSP Import Template
ds.Range(ds.Range("A4:R18"),
ds.Range("A4:R18").End(xlDown)).ClearContents
'Counts the rows with data on the source spreadsheet and adds the
appropriate number to the destination (Import sheet)
ss.Activate
Your instructions aren't descriptive yet, so I can't help too much. We'll discuss in the comments and I'll improve my answer as we go.
Sub Map_To_Import_Sheet()
Dim srcWb As Workbook 'Source workbook
Dim destWb As Workbook 'Destination workbook already open
Dim srcSht As Worksheet 'Source worksheet
Dim destSht As Worksheet 'Destination worksheet
Set destWb = ThisWorkbook
Set srcWb = Workbooks.Open("filepath")
Set srcSht = srcWb.Worksheets(1)
Set destSht = destWb.Worksheets("Import Sheet")
'Removes the data from the columns A through R in NHSP Import Template
'- Import Sheet
destSht.Range(destSht.Range("A4:R18"), destSht.Range("A4:R18").End(xlDown)).ClearContents
'Counts the rows with data on the source spreadsheet and adds the
'appropriate number to the destination (Import sheet)
Dim count As Integer
count = srcSht.Range("cell formula location").Value
srcSht.Range("cell formula location").Copy
destSht.Range("new cell formula location").PasteSpecial xlPasteFormulas
'MsgBox count 'prints out count
'explain your insert more please
End Sub
Related
I have two excel files, one with multiple excel worksheet with each month as worksheet name, for month Aug, it will have 8 worksheets, for Oct it will have 10 worksheets and so on. The other excel which is the excel file that I'm working on it, i need to import last worksheet from the monthly excel file into this excel as the first worksheet because there are macro code need it to be in first worksheet.
In short, import duplicate/'create new copy' of last sheet (worksheet name always change) to another workbook as first worksheet.
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim rngCopy As Range
Dim wbPaste As Workbook
Dim wsPaste As Worksheet
Dim rngPaste As Range
Set wbPaste = ActiveWorkbook
Set wbCopy = Workbooks.Open("O:\abc\Inventory\Monthly.xlsm")
Set wsCopy = wbCopy.Worksheets("Sheet1") 'Question- how to always select last worksheet?
Set rngCopy = wsCopy.Range("a:aa").EntireColumn 'Question- can i duplicate a copy of worksheet ?
Set wsPaste = wbPaste.Worksheets("Order Quantities")
Set rngPaste = wsPaste.Range("a1") 'Question- this just paste into "Order Quantities", but how to move or duplicate the worksheet into first worksheet in excel workbook. ?
rngCopy.Copy
rngPaste.PasteSpecial
Workbooks.Application.CutCopyMode = False
Workbooks("Monthly.xlsm").Close False
Worksheets.count will give you the index of the last worksheet in the queue.
dim wbPaste as workbook
Set wbPaste = ActiveWorkbook
with Workbooks.Open("O:\abc\Inventory\Monthly.xlsm", readonly:=true)
.workSheets(.Worksheets.count).Copy Before:=wbPaste.Sheets(1)
.close savechanges:=false
end with
'optionally rename the new imported worksheet
wbPaste.workSheets(1).name = "abc"
I have three workbooks.
One workbook is a list I add to every month, of things I need to delete from a second workbook. I receive a second workbook every month. The second workbook I receive always contains extraneous entries (the number growing every month) and will not be fixed anytime soon. There is no general filter I can make without making the second workbook useless, so I need to be really specific and have a silly cleaning list.
My third workbook is where I run all of my workbook cleaning macros from.
The objective is to compare the entries in column A or B on the first workbook with the entries in column A or B of the second workbook I receive. If any of the entries match, delete the entire row on the second workbook.
I will be doing this once a month for a few hundred lines, and it will be run from a macro assigned to a shape on a third workbook.
Here I am posting some code that lets me open my two files and copy the contents of one of them, but what I need is code that will compare and delete rows on Workbook 2 that match with Workbook 1. My own code to do exactly that is terrible, not worth posting at all.
Code:
Sub test()
Dim strFileName As String
Dim wbTarget As Workbook
Dim wbSource As Workbook
Dim wsTarget As Worksheet
Dim wsSource As Worksheet
strFileName = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open data")
Set wbSource = ThisWorkbook
Set wbTarget = Workbooks.Open(strFileName)
Set wsSource = wbSource.Worksheets("Sheet1")
Set wsTarget = wbTarget.Worksheets("Sheet1")
'to copy from Target - > Source
wsTarget.Range("B2").Resize(5, 5).Copy wsSource.Range("B2")
'etc.
End Sub
Code, comment and suggestion is greatly appreciated!
Cheers,
Christopher
CODE UPDATE 8:30 AM: This is a new way I am thinking of making things work. I am getting a type mismatch error on the code line Set Rng = Range("A1:B10000" & LR)
Sub test()
Dim strFileName As String
Dim strFileName2 As String
Dim wbTarget As Workbook
Dim wbSource As Workbook
Dim wsTarget As Worksheet
Dim wsSource As Worksheet
Dim LR
Dim Rng As Range
strFileName = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open 'Things Which Have Been Removed'")
strFileName2 = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open This Month's Purge List")
Set wbSource = ThisWorkbook
Set wbTarget = Workbooks.Open(strFileName)
Set wsSource = wbSource.Worksheets("Sheet1")
Set wsTarget = wbTarget.Worksheets("Sheet1")
Set LR = wsSource.UsedRange.Rows
With wbTarget.Sheets(1)
Set Rng = Range("A1:B10000" & LR)
Rng.RemoveDuplicates Columns:=Array(4), Header:=xlNo
End With
End Sub
To answer your specific question.
Set Rng = Range("A1:B10000" & LR)
Should be
Set Rng = Range("A1:B" & LR)
I would like to help with your other issues, but your description is confusing, this is what I understand; you identify bad information in the second workbook and copy that information from the second workbook to the first workbook, then you want a macro to match what is in the first workbook to the second workbook and delete the rows in the second workbook that match. Question, why don't you delete the rows in the second workbook instead of copying them to the first workbook?
You can use find method ; after open workbook u can use this code, findind the cell adress u can easily delete it clear command
Dim GCell As Range
Set GCell = ActiveSheet.Cells.Find("yourvariable")
I need to create a macro in my CountResults.xlsm (Master Workbook) that solves the following problem. I have a column of data in another worksheet with either YES or NO. I need to come up with a macro that counts the amount of "YES" in the column. The column is located in Sheet2 of the workbook Test01.xlsx. Then take that count and put it in one cell in my CountResults.xlsm file. Like so:
I have a code that displays a count for a column in the same sheet. But this code does not count when there are 'breaks' in the column (empty spaces) like I have in my picture. This is that code:
Private Sub CommandButton1_Click()
MsgBox Range("A1").End(xlDown).Row
Range("A1").End(xlDown).Offset(1, 0).Select
End Sub
I have another code that helps with accessing another workbook and defining values for each workbook and worksheet:
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim shSource As Worksheet
Dim shTarget As Worksheet
Set wbSource = Workbooks.Open(Filename:="C:\Users\khanr1\Desktop\Test_Excel\Test03.xlsm", ReadOnly:=True)
Set wbTarget = ThisWorkbook
Set shSource = wbSource.Worksheets("Sheet2")
Set shTarget = wbTarget.Worksheets("Sheet1")
Use COUNTIF. It will give you the total even if the range is in another workbook. i.e. =COUNTIF([Book2.xlsx]Sheet2!$D$2:$D$9, "Yes"). Problem with having COUNTIF within your sheet as a formula is that you will need to open the other workbook if you want the count to be update. Below VBA code will perform an update for you. Assign the sub to a button in your CountResults.xlsm workbook
EDIT: Added row count as per OP's requirement
Sub UpdateResults()
Dim oWBWithColumn As Workbook: Set oWBWithColumn = Application.Workbooks.Open("<your Test01.xlsx address here>")
Dim oWS As Worksheet: Set oWS = oWBWithColumn.Worksheets("Sheet2")
Dim intLastRow as Integer: intLastRow = oWS.Cells(Rows.Count, "B").End(xlUp).Row
ThisWorkbook.Worksheets("<name of the sheet in your CountResults.xlsm workbook>").Range("<cell address>").Value = Application.WorksheetFunction.CountIf(oWS.Range("B2:B" & intLastRow), "yes")
oWBWithColumn.Close False
Set oWS = Nothing
Set oWBWithColumn = Nothing
End Sub
I have a plethora of Excel workbooks containing 25+ worksheets each containing 20 columns of data from range 1:500 (or 1:1000 in some cases). Frequently I am tasked with updating the "template" onto which new data is entered for new calculations. I want to be able to easily paste extant data from old worksheets into sheets with new formatting while retaining any new formatting/formulas in the new templates.
I am using VBA to open the sheet I want to copy and paste it onto the new template sheet. So far my code will copy everything from the first sheet (S1) of the to-be-copied workbook and paste it onto the first sheet (S1) of the target workbook.
I want to extend this process to go through all active sheets (do whatever it is doing now for each sheet in the workbooks). I previously was able to do this with different code but it removed the formulas in rows 503 and 506 that I need when it pasted in. Can I do a pastespecial and skip empty cells? I am new to this.
Here is my current code:
Sub CopyWS1()
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks("Ch00 Avoid.xlsx")
Set y = Workbooks("Ch00 Avoid1.xlsx")
Dim LastRow As Long
Dim NextRow As Long
x.Worksheets("S1").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row
Range("A2:T" & LastRow).Copy y.Worksheets("s1").Range("A1:A500")
Application.CutCopyMode = False
Range("A1").Select
End Sub
I believe that I need to use something like the following code in order to extend this across the worksheets, but I'm not sure how to iterate through the sheets since I'm specifically referencing two sheets in my above code.
Sub WorksheetLoop2()
' Declare Current as a worksheet object variable.
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
' Insert your code here.
' This line displays the worksheet name in a message box.
MsgBox Current.Name
Next
End Sub
I imagine that I might be able to solve this as a for loop across an index of worksheets (make a new variable and run a for loop until my index is 25 or something) as an alternative, but again, I'm not sure how to point my copy/paste from a particular sheet to another sheet. I am very new to this with semi-limited experience with Python/Java only. These VBA skills would greatly benefit me on the day to day.
The two files in question:
Ch00 Avoid
Ch00 Avoid1
This should do it. You should be able to drop this in a blank workbook just to see how it works (put some values in column A on a couple of sheets). Obviously you will replace your wbCopy and wbPaste variables, and remove the wbPaste.worksheets.add from the code (my excel was only adding 1 sheet in the new workbook). LastRow is determined per your code, looking up from column A to find the last cell. wsNameCode is used to determine the first part of your worksheets you are looking for, so you will change it to "s".
This will loop through all sheets in your copy workbook. For each of those sheets, it's going to loop 1 through 20 to see if the name equals "s" + loop number. Your wbPaste has the same sheet names, so when it finds s# on wbCopy, it is going to paste into wbPaste with the same sheet name: s1 into s1, s20 into s20, etc. I didn't put in any error handling, so if you have an s21 on your copy workbook, s21 needs to be on your paste workbook, and NumberToCopy changed to 21 (or just set it to a higher number if you plan on adding more).
You could have it just loop through the first 20 sheets, but if someone moves one it will throw it all off. This way sheet placement in the workbook is irrelevant as long as it exists in the paste workbook.
You can also turn screenupdating off if you don't want to have a seizure.
Option Explicit
Sub CopyAll()
'Define variables
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim wbPaste As Workbook
Dim LastRow As Long
Dim i As Integer
Dim wsNameCode As String
Dim NumberToCopy As Integer
'Set variables
i = 1
NumberToCopy = 20
wsNameCode = "Sheet"
'Set these to your workbooks
Set wbCopy = ThisWorkbook
Set wbPaste = Workbooks.Add
'These are just an example, delete when you run in your workbooks
wbPaste.Worksheets.Add
wbPaste.Worksheets.Add
'Loop through all worksheets in copy workbook
For Each wsCopy In wbCopy.Worksheets
'Reset the last row to the worksheet, reset the sheet number search to 1
LastRow = wsCopy.Cells(65536, 1).End(xlUp).Row
i = 1
'Test worksheet name to match template code (s + number)
Do Until i > NumberToCopy
If wsCopy.Name = (wsNameCode & i) Then
wsCopy.Range("A2:T" & LastRow).Copy
wbPaste.Sheets(wsNameCode & i).Paste
End If
i = i + 1
Loop
Next wsCopy
End Sub
Thank you for all of your help, everyone. I went back yesterday afternoon from scratch and ended up with the following code which, at least to my eyes, has solved what I was trying to do. The next step will be to try to make this less tedious as I have a gajillion workbooks to update. If I can find a less obnoxious way to open/update/save/close new workbooks, I will be very happy. As it stands now, however, I have to open both the example workbook and the target workbook, save both, and close...but it works.
'This VBA macro copies a range of cells from specified worksheets within one workbook to a range of cells
'on another workbook; the names of the sheets in both workbooks should be identical although can be edited to fit
Sub CopyToNewTemplate()
Dim x As Workbook
Dim y As Workbook
Dim ws As Worksheet
Dim tbc As Range
Dim targ As Range
Dim InxW As Long
Dim WshtNames As Variant
Dim WshtNameCrnt As Variant
'Specify the Workbook to copy from (x) and the workbook to copy to (y)
Set x = Workbooks("Ch00 Avoid.xlsx")
Set y = Workbooks("Ch00 Avoid1.xlsx")
'Can change the worksheet names according to what is in your workbook; both worksheets must be identical
WshtNames = Array("S1", "S2", "S3", "S4", "S5", "S6", "S7", "s8", "s9", "S10", "S11", "S12", "S13", "S14", "S15", _
"S16", "S17", "S18", "S19", "S20", "Ext1", "Ext2", "Ext3", "EFS BigAverage")
'will iterate through each worksheet in the array, copying the tbc range and pasting to the targ range
For Each WshtNameCrnt In WshtNames
With Worksheets(WshtNameCrnt)
'tbc is tobecopied, specify the range of cells to copy; targ is the target workbook range
Set tbc = x.Worksheets(WshtNameCrnt).Range("A1:T500")
Set targ = y.Worksheets(WshtNameCrnt).Range("A1:T500")
Dim LastRow As Long
Dim NextRow As Long
tbc.Copy targ
Application.CutCopyMode = False
End With
Next WshtNameCrnt
End Sub
I need to copy a range of cells from one workbook to another. However, unfortunately, because of the size of the two workbook I can't have them open at the same time.
So the idea was to do it in two steps:
1) Open workbook1 save the range from one workbook to a object range and close workbook1
2) Open workbook2 save the range from the object to the range in workbook
But this is not working. Could someone help with the code. Thanks. Sample code below
Dim Temp as Range
Workbooks.Open (Model1)
Workbooks(Model1).Activate
Temp = Range("First_Input").Value
Workbook(Model1).Close
Workbooks.Open(Model2)
Workbooks(Model2).Activiate
Range("Second_Input").Value = Temp.Value
A working example below:
Comments are embedded and works as is (without changes). Try this on a
workbooks first with random data.
The example works for a workbook already open, just alter it for "Opening" a workbook.
I have used the range address in the example. You can play with this depending on what you want to do.
The below works so should be easy to implement, copy and paste into excel.
Public Sub CopyData()
Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim wkb1rng As Range
Dim wkb2rng As Range
'Point to Workbook and Sheet 1
'Set wkb1 = Workbooks.Open(Model1) ' To Open Workbook
Set wkb1 = Workbooks("Book1") ' If workbook is open already
'Sheets is the Index use String for the sheet name
Set sht1 = wkb1.Sheets(1)
' Dont need this if you moving objects directly in and out of memory.
' Workbooks(Model1).Activate
' Point to Range
Set wkb1rng = sht1.Range("First_Input")
' What is the address of the Range
Dim address As String
address = wkb1rng.Cells.address
'Point to Workbook and Sheet 2
Set wkb2 = Workbooks("Book2")
'Sheets is the Index use String for the sheet name
Set sht2 = wkb2.Sheets(1)
'I imagine Second_Input should be output?
'Use this only if the data range is exactly the same size
'Set wkb2rng = Range("Second_Output")
'else use this ...
Set wkb2rng = sht2.Range(address)
'Copy data across ...
wkb2rng.Value = wkb1rng.Value
End Sub