Working with Named Ranges and Objects - vba

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

Related

VBA Copy Worksheet to a Different Open Workbook

I keep getting an Out of Range error when trying to copy a sheet from on workbook to another. The original spreadsheet (Master_Data.xlsm) is what is running the vba script. The scripts opens another spreadsheet, manipulates it, then copies the final sheet to be pasted in the Master_Data.xlsm Workbook.
Sub Result_Scrapper()
Dim wb As Workbook, ws As Worksheet, wbFile As Object
Dim masterBook As Workbook
Dim wsa As Worksheet
Dim year As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("C:\Users\Output_Spreadsheets\")
Set masterBook = Excel.Workbooks("Master_Data.xlsm")
Application.ScreenUpdating = False
For Each wbFile In fldr.Files
If fso.GetExtensionName(wbFile.Name) = "xlsm" Then
Set wb = Workbooks.Open(wbFile.Path)
'Copy sheet of interest
ActiveSheet.Copy 'Before:=ThisWorkbook.Sheets(“A”) 'tried doing it using before statement but it also caused errors
'paste sheet into masterBook spread--this is where the error comes
masterBook.Sheets(Sheets.Count).Paste
End If
masterBook.Sheets("master").Name = Right([A2], 30)
Next wbFile
There are two issues. First, as someone else commented, you need to fully qualify the count. Second, you'll want to do it on one line; and you could do before, but then you're just pushing out whatever that last sheet is, if you add it after, then the sheets stay in order.
Try:
ActiveSheet.Copy After:=masterBook.Sheets(masterBook.Sheets.Count)

Compare two workbooks, delete matching rows

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")

Add rows based on a specific number in a cell using VBA

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

Excel VBA: Counting Data in Column from Another Workbook and Inputting Counter in Master Workbook

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

Copy the value from a cell in a worksheet into a range of cells

I'm intending to conduct a macro which will open up a workbook from the specified path, and loop through its worksheets which has the names "Januari, Februari, Mars" specifically, to deduct the value from C34. C34 has a value recorded there every time, so it shouldn't change. However I want to copy it to the current worksheet, where the first target should be at AA73, the second at AA74 etc. My code is
Sub Test()
Dim myHeadings
Dim i As Long
Dim path As String
path = "C:\pathtofile\file.xlsx"
Dim currentWb As Workbook
Set currentWb = ActiveWorkbook
Dim openWb As Workbook
Set openWb = Workbooks.Open(path)
Dim openWs As Worksheet
myHeadings = Array("Januari", "Februari", "Mars")
For i = 0 To UBound(myHeadings)
Set openWs = openWb.Sheets("&i")
currentWb.Sheets("Indata").Range("AA73+Application.Match(i,Array,False)").Value = openWs.Range("C34").Value
Next i
End Sub
However the compiler says that the subscript is out of range at the row with
Set openWs = openWb.Sheets("&i")
Here I've tried to do "i", i, &i among other things, but it haven't changed. Also I've tried to use "ThisWorkbook" instead of "ActiveWorkbook" but it didn't help either. Does anybody have an input as to how to achieve this in a more proper way?
EDIT: Adapting to the response from Dave, it works to import the sheets. However I get an error in:
currentWb.Sheets("Indata").Range("AA73+Application.Match(i,Array,False)").Value = openWs.Range("C34").Value
Where I get Automation Error -2147221080 (800401a8) at said code snippet.
You have already put your sheet names into an array, so you can just call the sheet name from the array as:
Set openWs = openWb.Sheets(myHeadings(i))