I'm currently rewriting a small stock system for my work, and trying to speed up the program as it's dog slow and I have only been doing VBA for 2 weeks now.
In Excel 2003 Edition.
My issue (I think) is creating a identifier(s).
I have two and they are as follows:
Dim QuickView As String
QuickView = ActiveWorkbook.Range("a1:c200").Copy
Dim Stock As String
Stock = ActiveWorkbook.Range("c1:c200").Copy
My users currently select a file(WORKBOOK) from an open dialogue and I am importing the data in the ranges specified.
However, when I come to call these functions I get "Object does not support this property or method".
im unsure if this should be a UDF, as i can't see anywhere where you can write your own VBA function opposed to write a function in VBA for Excel to use.
In your two examples, both "QuickView" and "Stock" should be variants, not strings.
Dim Stock As Variant
Stock = ActiveWorkbook.Range("c1:c200").Copy
Remember, you do NOT need to assign ranges to a variable in order to copy (or cut) cell values to another location. Instead, you can do it like this:
ActiveWorkbook.Sheets("Sheet1").Range("c1:c200").Copy
ThisWorkbook.Sheets("Sheet1").range("c1")
The convention is copy_from [SPACE] put_it_here.
Note: In my example above, the values would be copied into Sheet1 of the workbook that contains the running code. The workbook running the VBA is always ThisWorkbook.
As #timbur said, you can copy a range without assigning it first. If you want to assign it, the variable must be of type Range (or Variant) and you must assign using Set, like any object assign.
Dim stock as Range 'or Variant, but Range is better
Set stock = ActiveWorkSheet.Range("c1:c200")
'copy, and optionally paste at once
stock.Copy Destination:=ThisWorkbook.Sheets("Sheet1").range("c1")
eSolved it guys, thanks for your answers :-D
Sub Button1_Click()
Dim FileOpened As Boolean ' Holds True or False value
Dim SourceRange As Range
Dim TargetRange As Range
Dim MasterWorkbook As Workbook
Dim Row As Integer
' Remember the current workbook we are clicking the button from.
Set MasterWorkbook = ActiveWorkbook ' Use Set = for all complex types.
' Identify file to open.
ChDrive "C:"
ChDir "c:\"
On Error Resume Next ' Temporarily ignore errors in situation when user says no to opening the same master file a second time.
FileOpened = Application.Dialogs(xlDialogOpen).Show
On Error GoTo 0 ' Reinstates normal error reporting.
' Don't process the file if the user cancels the dialog.
If FileOpened Then
' The opened file automatically becomes the new active workbook and active worksheet.
Set SourceRange = ActiveSheet.Range("c1:c394")
Set TargetRange = MasterWorkbook.ActiveSheet.Range("b1:b394")
' Copy cell values one at a time from the source range to the target range.
For Row = 1 To 394
TargetRange.Cells(Row, 1).Value = SourceRange.Cells(Row, 1).Value
Next
ActiveWorkbook.Close
' Set background colour of target range.
TargetRange.Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
' Tell Excel to recalculate only those formulas which use the target values.
TargetRange.Dirty
End If
End Sub
For those interested in this code :
User selects a file from nominated directory then selects the nominated range "c1:c394" from that file and pasts it into the "sheet1".
Bypassing clipboard and updates any formulas affected by the added values.
Related
This is my first question on this site and I'm not a programmer, so please bear with me.
I am trying to create an Excel 2013 macro that will compare values in column A on one workbook ("active workbook") to column A's of other Excel files in a particular directory. Duplicate values (rows) would then be deleted from the active workbook.
I have been working piece by piece trying to figure this out as I am not a programmer. So far I have been able to use conditional formatting to highlight unique values when the two columns are side by side (same worksheet). I used =ISNA(MATCH($A2,$B$2:$B$12,0)).
Then I used a macro to print out the duplicate values to another column (instead of highlighting them.. I am still at this stage comparing two columns within the same worksheet). I did this by using the following macro:
Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
' Set CompareRange equal to the range to which you will
' compare the selection.
Set CompareRange = Range("C1:C12")
' NOTE: If the compare range is located on another workbook
' or worksheet, use the following syntax.
' Set CompareRange = Workbooks("Book2"). _
' Worksheets("Sheet2").Range("C1:C5")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 1) = x
Next y
Next x
End Sub
Then I tried removing duplicate values from two different worksheets but that didn't work:
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Dim Counter As Integer
Set wb1 = ActiveWorkbook
Set PasteStart = [RRimport!A1]
Pathname = ActiveWorkbook.Path & "\For Macro to run\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb2 = Workbooks.Open(Pathname & Filename)
For Each Sheet In wb2.Sheets
With Sheet.UsedRange
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
Next Sheet
wb2.Close
Filename = Dir()
Loop
End Sub
I've been reading this site for couple of days and also searched through YouTube. I haven't had much success after the first two basic things I did.
Background of the project: Everyday we have a list called "Pending List" which essentially is all of the projects we need to get done. Everyday this list grows. Each project is given a unique identifier (numeric value) that is listed in column A of the active workbook. Every day I create my own files of the projects that are being completed. Instead of manually checking off each project one by one by comparing several files every day, I would like Excel to be able to delete the duplicates (meaning the projects that are both on my pending list and in the other files, and only leave the unique projects that still need to be done. Hope I didn't confuse anyone but if I did, please let me know.
The question here:
I am trying to create an Excel 2013 macro that will compare values in
column A on one workbook ("active workbook") to column A's of other
Excel files in a particular directory. Duplicate values (rows) would
then be deleted from the active workbook.
So, let's break this down:
There is a directory from which workbooks need to be opened.
When one of the workbooks is open, you want to check column A (I assume this is on the first worksheet for the sake of the example below) for values you have in column A in your active workbook (the one that will run the macro).
If there's a match, delete the row from the active workbook in which the value was stored.
When done, continue with the next workbook in the directory.
Point 1 and 4: Open some files from a specific directory:
We will need some function to open and close the files. This question has been asked many times on SO, for example here
Also, we're going to need the workbooks to be stored in some variable that we will pass to the comparison in the next step.
Public Sub LoopOverFiles()
'Our variables:
Dim wb1 As Workbook 'To hold the active workbook / the macro workbook
Dim wb2 As Workbook 'To hold the workbook we'll be comparing to later on
Dim scanFolder As String 'To set the folder in which the files will be located
Dim fileNameToOpen As String 'To get the filenames that we will open
Set wb1 = ThisWorkbook
scanFolder = "C:\temp\"
fileNameToOpen = Dir(scanFolder & "*.xlsx")
'And loop over the files:
Do While Len(fileNameToOpen) > 0 'To exit the loop when there's no more xlsx files
Set wb2 = Workbooks.Open(scanFolder & fileNameToOpen)
'To do the actual comparison of the 2 workbooks, we call our compare routine.
DoTheComparison wb1, wb2 'Note we'll be passing the two workbooks as parameters to the compare function
wb2.Close SaveChanges:=False 'We don't want to leave it open after we're done with it.
fileNameToOpen = Dir 'To continue with the next file.
Loop
End Sub
Point 2 and 3: Do the comparison and delete some rows
As you can see, the actual comparison will be done by a routine that's called DoTheComparison and that takes 2 workbooks as parameters. Based on the first routine, we know that the workbooks that will be passed are the correct ones (wb1 being the active one, wb2 being the variable one that gets opened during the loop).
In this example we'll stick to the first worksheet in wb2.
Public Sub DoTheComparison(wb1 as Workbook, wb2 as Workbook)
'Dim compareFrom as Range - Not needed.
Dim compareTo as Range
Dim compareFromCell as Range
Dim compareToCell as Range
Dim i as Integer
'EDIT: Since we delete, we need a backwards loop. This can't be done with "for each" so we'll use "for" with step -1.
'That is why we also don't need the "CompareFrom" range variable anymore.
Set compareTo = wb2.Worksheets(1).Range("A2:A20")
For i = 20 to 2 step -1
Set compareFromCell = wb1.Worksheets("RemoveValsFromHere").Range("A" & i) 'We get the cells based on the index.
For Each compareToCell in compareTo
If compareFromCell.Value = compareToCell.Value Then 'Point 3:
compareFromCell.EntireRow.Delete shift:=xlUp
Exit For
'Note that we need to exit the inner loop:
'After a match was found, the "compareFromCell" is deleted after all.
'Therefore we have to continue with the next compareFromCell, otherwise we'll get an error.
End If
Next compareToCell
Next i
End Sub
Note that especially DoTheComparison is written for maximum clarity, not for optimal speed (far from it!). I see in your question you've been looking into comparing variants / arrays, which is indeed a lot faster.
EDIT: I altered the code above since you're facing the "skipping cells" issue due to cell deletion. In short: The index changes, so when moving to the next cell after deletion the index is wrong. The fix is an easy backwards for loop. Also see this question and answer
I have six different forms, all of which contain the same information but in different places. These forms are sent to me by other parties and once I receive them, I open the file, determine which form I am dealing with, then run the appropriate transposition macro to upload the information to my summary workbook.
I would like to be able to check cells B4, B8, B10, B15 and B20 to ascertain what form I am dealing with, then have the appropriate transposition macro run on its own.
Can someone please help me set this up?
Right now I have the following:
' I use the file path to identify the form that I want to copy information from
Dim FilePath As String
Dim InputTemplate As Workbook
Dim UploadForm As Workbook
Dim Analysis As Worksheet
Dim supplierdata As Worksheet
Dim TemplateType
Set UploadForm = ActiveWorkbook
FilePath = UploadForm.Sheets("Summary").Range("D4").Value
Set InputTemplate = Workbooks.Open(FilePath)
Set Analysis = UploadForm.Sheets("Analysis")
Set supplierdata = InputTemplate.Sheets("Supplier Input Template")
How do I say that if B4.value=Company Name, B8.value=Date, B10.value = Currency... then run the correct transposition macro?
The most-condensed you could do it might be something like:
'....
Set supplierdata = InputTemplate.Sheets("Supplier Input Template")
With supplierdata.Columns(2)
If .Cells(4).value = "Company Name" And .Cells(8).Value="Date" _
And .Cells(10).Value = "Currency" Then
'handle this type of form
End If
End With
If you have many of these types of checks to perform, then you could consider using a "metadata-driven" approach, where you list on a worksheet the Ranges and the corresponding content, and loop over that information to detect the type of report. That would be more coding up-front but easier ongoing maintenance once you have it set up.
I'm working on a vba macro for an excel sheet and I'm not sure how to go about doing one of my functions. I have a private sub in the macro that is used to get the path of a .csv file (say C:/files/file.csv stored as variable 'csvfile').
What I need to do at this point is automatically pull information from that csv file according to a certain formula and save it as a variable:
=COUNTIFS(F2:F10000,"=medium",Z2:Z10000,"=Open")
So in summary, in a macro in spreadsheet Main.xlsx, I need to run the above formula on the file whose path is stored in variable csvfile, and save the returned number as a variable within the macro so I can make use of that number in my macro.
I'll need to do this nine times actually with the formula slightly different each time, but once I have the single variable worked out I think I'll be able to modify it to produce all the results I need.
Thanks
Here's an example of one way to do it:
Sub OpenAndCount()
Dim sFile As String
Dim wb As Workbook
Dim ws As Worksheet
Dim cnt As Long
Dim rng1 As Range
Dim rng2 As Range
sFile = "c:\files\file.csv"
Set wb = Workbooks.Open(sFile)
Set ws = wb.Sheets(1)
Set rng1 = ws.Range("F2:F100000")
Set rng2 = ws.Range("Z2:Z100000")
cnt = Application.WorksheetFunction.CountIfs(rng1, "=medium*", rng2, "=open")
Debug.Print cnt
wb.Close
End Sub
I am trying to figure this out all day. This is what I need to accomplish:
Using GetFile select a number of workbooks without opening them.
Compare Cell A2 of selected workbooks indiviually in loop to a reference workbook.
If Cell A2 of the selected workbook equals the numerical value of the numerical value within the reference workbook contained within column A then copy/past column B's text in the corresponding cell of the matched reference workbook cell to M2 of the selected workbook.
Sounds complicated but let me demonstrate. The letters represent column names.
Selected Workbook
A2=12 M2= ""
Reference Workbook
A2=12 B2=milk, protein
Desired result:
Selected Workbook
A2=12 M2=milk, protein
So far this is the code I have:
Sub Click()
Dim rCell As Range, vVal1, vVal2
Dim wbCheck As Workbook
For Each rCell In Workbooks("2.xls").Worksheets(1).Range("A1:C100")
vVal1 = rCell
vVal2 = ThisWorkbook.Worksheets(1).Range(rCell.Address)
If IsNumeric(vVal1) And IsNumeric(vVal1) Then
If vVal1 = vVal2 Then
rCell.Interior.ColorIndex = 3
ElseIf vVal1 < > vVal2 Then
End If
End If
Next rCell
End Sub
Why do you need a VBA code for this?
This can be achieved using an Excel Formula.
Paste this in M2 and copy it down
=IF(A2='C:\[Ref.xlsx]Sheet1'!A2,'C:\[Ref.xlsx]Sheet1'!B2,"")
My Assumptions (Please change as applicable)
The reference file name is Ref.xlsx
You are pulling data from Sheet1 of reference file
The Ref.xlsx is in C:
EDIT
Even if you want to use VBA, you can also do this.
Sub Sample()
Application.Calculation = xlCalculationManual
ThisWorkbook.Sheets("Sheet1").Range("M2").Formula = _
"=IF(A2='C:\[Sample.xlsx]Sheet1'!A2,'C:\[Sample.xlsx]Sheet1'!B2,"""")"
Application.Calculation = xlCalculationAutomatic
End Sub
The above formula or code is beneficial becuase of what you mentioned in 1st point Using GetFile select a number of workbooks without opening them. If you do not want to open the file then the formula or formula in VBA is the way to go :)
I solved my own question. The answer was to use VLookup.
=VLOOKUP(I2, 'C:\Desktop\Merge[ISReference.xlsx]Reference'!B2:G1923, 6, FALSE)
I am surprised no one suggested this to me. Given its simplicity I was able to build this function into some code I built to run through a FSO filedialog picker on a form in access and link external workbooks with Vlookup.
Thanks Siddarth for giving the proper direction of embedding a function instead of crazy iterated loop.
I have made an assessment system for a project using Microsoft Excel and I wanted to to make it so that you could use the same drop down menus twice.
Enter the data and then for the spreadsheet to retain that data and allow you to overwrite it but still maintain the data but to be dependant on the value of a data validation drop down list.
I have been given the code for this and it works however only for a section of the spreadsheet.
I wish to have the same effect however use a different drop down menu and for it to affect a different section of the spreadsheet.
Please feel free to ask for the actual spreadsheet or code.
Here is the Code:
Option Explicit
Public Sub Worksheet_Change(ByVal Target As Range)
' This Sub is a standard VBA event handler. It is automatically invoked
' every time the content of any cell in this worksheet changes
' We are only interested if the user picks a different type of
' grade. A named range GradeType was created to name this cell.
' This allows the worksheet format to change without having to change
' this code.
If Target.Address = Sheet1.[GradeType].Address Then
' So the user doesn't see each invidual worksheet change as it happens
Application.ScreenUpdating = False
' Where the current data will be saved to
' These are in the first row, so the number of columns has
' to be determined on the fly based on how much data is there
Dim FirstSaveTo As Range
Dim LastSaveTo As Range
' Where the previous saved data will be restored from
Dim LastRestoreFrom As Range
Dim FirstRestoreFrom As Range
' Use variables to define the relevant spaces in the Save sheet
' depending on what grade type the user selected
If [GradeType] = "Attainment" Then
Set FirstSaveTo = Save.[AttainmentStart]
Set LastSaveTo = Save.[AttainmentEnd]
Set FirstRestoreFrom = Save.[EffortStart]
Set LastRestoreFrom = Save.[EffortEnd]
Else
Set FirstRestoreFrom = Save.[AttainmentStart]
Set LastRestoreFrom = Save.[AttainmentEnd]
Set FirstSaveTo = Save.[EffortStart]
Set LastSaveTo = Save.[EffortEnd]
End If
' Save current data
' Clear previously saved data
Save.Range(FirstSaveTo, LastSaveTo).EntireColumn.ClearContents
' Copy current data
Sheet1.Range(Sheet1.[AssessmentFirst], Cells(Sheet1.UsedRange.Rows.Count, Sheet1.[AssessmentLast].Column)).Copy
' Paste
FirstSaveTo.PasteSpecial xlPasteValues
' Restore saved data
' Clear current data
Sheet1.Range(Sheet1.[AssessmentFirst], Cells(Sheet1.UsedRange.Rows.Count, Sheet1.[AssessmentLast].Column)).ClearContents
' Copy saved data
Save.Range(FirstRestoreFrom, Save.Cells(Save.UsedRange.Rows.Count, LastRestoreFrom.Column)).Copy
' Paste saved data
Sheet1.[AssessmentFirst].PasteSpecial xlValues
' Deselect copy area
Application.CutCopyMode = False
' Put user back where he started
[GradeType].Select
Application.ScreenUpdating = True
End If
End Sub
Your code is getting currently applied to the Named Range GradeType.
If you want to apply your code to another drop-down list, you can change this line:
If Target.Address = Sheet1.[GradeType].Address Then
And adapt it to whatever you need (don't forget to create a new named range first).
In order to do this, have a look at:
what is a named range and how to define it
how you can learn some vba: Programming Excel and VBA: Basic Syntax and Examples Tutorial