September 14, 2015, 6:29 pm
Howdy!
I'm getting an error on a recorded VBA that I'm hoping you can help me debug.
Code:
Sheets("HSJ").Unprotect Password:="enough"
With Range("H5").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=INDIRECT('local lists'!$K$9)"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
I receive the error on the line of code italicized. I'm not sure why it is having trouble. Can anyone help?
↧
September 15, 2015, 1:49 pm
Hello,
I am trying to append the data from multiple data sets.
What i have is time series data for 1500 companies on 5 different variables. So each sheet is the data for a specific variable like EPS for example. The column headers of each sheet is the company names and the data points are quarterly.
variable 1 variable 2
Quarter F1 F2 F3 Quarter F1 F2 F3
Q1 1.1 1.2 1.3 Q1 1.1 1.2 1.3
Q2 1.1 1.2 1.3 Q2 1.1 1.2 1.3
Q3 1.1 1.2 1.3 Q3 1.1 1.2 1.3
What i need is a panel data where the column headers would be: Company, Date, EPS, variable 2, variable 3 etc.
Firm Quarter Variable 1 variable 2
F1 Q1 1.1 1.1
F1 Q2 1.1 1.1
F2 Q1 1.2 1.2
F2 Q2 1.2 1.2
F3 Q1 1.3 1.3
F3 Q2 1.3 1.3
ETC...
I just need direction or ideas on the most efficient way to append this data.
please help!!
Thank You!
↧
↧
September 15, 2015, 1:57 pm
Hello All,
I am trying to optimize this macro since it is taking way to long to run. It has to go through around 10000 cells and takes about .5 seconds per cell. The whole purpose is to add together cells based on if there is specific text in column A
or if it is a specific cell color. Can anyone give me some tips on how to optimize this so it runs much faster.
Code:
Sub CreateSummation()
Sheets("Master").Select
Sheets("Master").Copy Before:=Sheets(1)
ActiveSheet.Name = "Summation"
Dim ws_count As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim t As Double
Dim Col As Integer
ws_count = ActiveWorkbook.Worksheets.Count
For k = 21 To 654
For j = 5 To 37
Col = Cells(k, j).Interior.ColorIndex
If Col = 36 Or Col = 40 Or Left(Cells(k, 2), 1) = 5 Or Left(Cells(k, 2), 1) = 6 Then
For i = 2 To ws_count
t = t + Worksheets(i).Cells(k, j).Value
Next i
Sheets("Summation").Cells(k, j) = t
t = 0
ElseIf Col = -4142 And j <= 17 Then
Sheets("Summation").Cells(k, 24).Copy
Sheets("Summation").Cells(k, j).Select
ActiveSheet.Paste
ElseIf Col = 34 And j <= 17 Then
Sheets("Summation").Cells(k, 24).Copy
Sheets("Summation").Cells(k, j).Select
ActiveSheet.Paste
End If
Next j
Next k
Columns("S:S").ClearContents
Columns("U:U").ClearContents
Columns("AH:AH").ClearContents
Columns("AJ:AJ").ClearContents
End Sub
↧
September 15, 2015, 2:01 pm
Hello,
I am trying to make a separate time stamp for data entered in cells (E1:E35) preferably have the individual time stamps next to the data cells ie. (D1:D35). I also need the time stamps font to turn red after ten minutes of no data entry in the coresponding cell. Thank you in advance.
↧
September 15, 2015, 2:16 pm
Hi,
in theory I want to loop through a folder and do something (Macro 1 and Macro 2 has descriptions below) on that file and move on to the Next one [Singing "On to the Next one" -Jayz song :) ]
Ok where was I...
Ah, So I wonder if macro 1 and 2 might be preventing this macro from going into the next file i choose?
any insight?
Code:
Sub ExcelFilesInFolder()
'**************************************************************************************************************
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'A good way to test it is to create a new workbook, name it and save it to your desktop(Get the file path).
'Once the "Master Book" is on your desktop, it will serve as the destination workbook of the data we're copying.
'When you run the code...
'it will start by having you choose the folder that contains all the workbooks you would like to copy the 1st
'sheet of.
'It loops through the folder, copies the data on the first sheet and pastes it to the destination folder.
'once the task is complete, open the "Master workbook" to see if everything was pasted succesfully.
'**************************************************************************************************************
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then Exit Sub
'Target File Extension (must include wildcard "*")
myExtension = "*.csv"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(FileName:=myPath & myFile)
'Do Work
'*******
Call Macro1 'Throw auto filter on first workbook on the file
Call Macro2 ' Opens a template located in another folder
'*******
'Saving the newly named workbook
Dim fPath As String
Dim newName As String
Dim revPosition
Dim revNumber As Long
fPath = "C:\Users\Desktop\Excel Files"
revPosition = InStr(1, fPath, "rpt_")
For revNumber = 2 To 100
newName = Left(fPath, revPosition + 2) & revNumber & ".xls"
If Dir(newName) = "" Then
Activeworkbook.SaveAs newName
Exit Sub
End If
Next revNumber
'**********************************************************************************************
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
'Reset Macro Optimization Settings
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
↧
↧
September 15, 2015, 2:19 pm
in my excel i have 13 sheets. 12 Sheets are the months of the year from Apr to Mar and each sheet there is every thing what i have bought and sold, the last sheet is the Total so far
on VBA Sheet 1 is the Total and sheet 2 Apr to sheet 13 Mar
Purchased Date is column B from row 3 to row 46 and sold Date is column C from row 3 to row 46.
what i want to do is when i put the sold date will cut the row from that sheet and past it in to the right sheet
for example: i have bought a car in 04/07/2015 that will be in July sheet, i sold it in 01/09/2015.
i want it automatic cut the row from column A row to column I and paste it to the next available row of Sep as the car been sold in Sep.
↧
September 15, 2015, 2:25 pm
Hello everyone
I have some data in columns("B:R") ..
The required in column A is to type Yes or No according to one criteria which is :
If there are 6 or more adjacent cells which has data in them then type Yes in column A
For example: in row 1 :(Range("I1:N1") all cells have data so the criteria is achieved so type "Yes" in A1
In Row 2 there is no range achieved the criteria so type in A2 the word "No"
I prefer UDF function for that task
Thanks advanced
↧
September 15, 2015, 3:50 pm
Hi All,
I'm VERY new to VBA and pretty decent with formulas. The attached .xls file shows an example of what I'm trying to accomplish (actual set-up, but bogus data). I have three sheets, "Compare", "Jun-15", and "Jul-15". The Jun and Jul worksheets have data with formatted cells with color. In the Compare worksheet I want to put the data side by side for easy visual comparison. I've got the formulas figured out to pull the data, but I want the returned values to retain their color formatting from the Jun and Jul worksheets. This is something I will do monthly, which is why I used "Indirect" in the formula, so I could easily update the months on my Compare sheet and have it automatically update data based upon whatever months I select.
Hope that makes sense. From what I can tell, I need to write a VBA code in order to do that, but I haven't been able to figure it out or find exactly what I need on the forum.
If someone knows how to do this, it would be GREATLY appreciated!!!
Project Comparison.xlsx
↧
September 15, 2015, 3:55 pm
Hi, Hoping someone could help,
We have several Workbook we would like to keep a record of how many times they are accessed. As each of theses workbooks are read only I cannot have the code save the counter in the individual workbooks.
What I thought was when you open a workbook, it pens the Counter workbook and increases the counter number by 1 (range "B2" in the code below. each workbook would have its own reference cell.
The code I have is below is what I am working on, but it no working properly.
When I open the test workbook instead of updating the counter.xlsm workbook it updates, it own sheet 1.
I must be missing something basic.
If someone could help, or suggest a better alternative I would welcome any suggestions.
Code:
Private Sub Workbook_Open()
Application.ScreenUpdating = False
ControlFile = ActiveWorkbook.Name
Filename = "C:\Projects\Counter Test\Counter.xlsm"
Workbooks.Open Filename:=Filename
ThisWorkbook.Activate
Windows("Counter.xlsm").Sheets("Sheet1").Range("B2").Value = Sheets("Sheet1").Range("B2") + 1
Workbooks("Counter.xlsm").Close SaveChanges:=True
Windows(ControlFile).Activate
End Sub
Thank you in advance
Brad
↧
↧
September 15, 2015, 4:05 pm
Hello,
I am trying to call an access database with Excel - version 2013. I have the below code but when I try to run it, it gives the error "Unspecified Error" and highlights the connection string:
Code:
Dim con As Object
Dim rs As Object
Dim AccessFile As String
Dim strQuery As String
Dim i As Integer
'Disable screen flickering.
Application.ScreenUpdating = False
'Specify the file path of the accdb file. You can also use the full path of the file like:
AccessFile = "[redacted]"
'Set the name of the query you want to run adn retrieve the data.
'strQuery = "VENDOR_SCORECARD"
strQuery = "SELECT [FiscalYear] & [FiscalMonth] AS YearQTR, SSRM_SELECTED_ORDERS.PO_NUMBER, SSRM_SELECTED_ORDERS.DESCRIPTION, SSRM_SELECTED_ORDERS.Vendor, SSRM_SELECTED_ORDERS.Buyer, Avg(IIf([ssrm_scores].[category]=""COST"",((IIf(IsNull([RESULT]),0,IIf([result]=""POOR"",1,IIf([result]=""AVERAGE"",5,10))))),Null)) AS COST, Avg(IIf([ssrm_scores].[category]=""SCHEDULE"",((IIf(IsNull([RESULT]),0,IIf([result]=""POOR"",1,IIf([result]=""AVERAGE"",5,10))))),Null)) AS " _
& "SCHEDULE, Avg(IIf([ssrm_scores].[CATEGORY]=""QUALITY"" Or [ssrm_scores].[category]=""OTHER"",((IIf(IsNull([RESULT]),0,IIf([result]=""POOR"",1,IIf([result]=""AVERAGE"",5,10))))),Null)) AS QUALITY, Sum(((IIf(IsNull([RESULT]),0,IIf([result]=""POOR"",1,IIf([result]=""AVERAGE"",5,10))))/10*[weight])) AS [Weighted Score] FROM SSRM_SELECTED_ORDERS INNER JOIN SSRM_SCORES ON (SSRM_SELECTED_ORDERS.FiscalMonth = SSRM_SCORES.MONTH_SELECTED) AND (SSRM_SELECTED_ORDERS.FiscalYear = SSRM_SCORES.YEAR_SELECTED) AND (SSRM_SELECTED_ORDERS.po_seqno = SSRM_SCORES.po_seqno) WHERE" _
& " SSRM_SELECTED_ORDERS.PO_NUMBER = 'XXXXXXXXXX' AND YEARQTR = '20151' GROUP BY [FiscalYear] & [FiscalMonth], SSRM_SELECTED_ORDERS.PO_NUMBER, SSRM_SELECTED_ORDERS.DESCRIPTION, SSRM_SELECTED_ORDERS.Vendor, SSRM_SELECTED_ORDERS.Buyer ORDER BY SSRM_SELECTED_ORDERS.PO_NUMBER"
On Error Resume Next
'Create the ADODB connection object.
Set con = CreateObject("ADODB.connection")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not created!", vbCritical, "Connection Error"
Exit Sub
End If
On Error GoTo 0
'Open the connection.
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
On Error Resume Next
'Create the ADODB recordset object.
Set rs = CreateObject("ADODB.Recordset")
I am also suspicious of the strQuery string. Thanks for your help!
↧
September 15, 2015, 4:16 pm
Hello,
I want to be able to pull data from an Excel Text Tab Delimited file into a separate Workbook. The TTD file, let's call it CURRENT, is constantly being updated with more information that I need. I have been able to utilize the Get External Data function to get this data from CURRENT. The problem lies in that I need to edit some of that data permanently, but when the Get External Data function is activated again, it overwrites any data that I have edited. Any insight?
↧
September 15, 2015, 6:16 pm
Good night,
I was wondering if there's a way to make a VBA macro to open some workbooks in a certain directory (the same where the workbook with the macro will be) in some user defined order. Lets make an example:
MacroWorkbook.xlsx
WorkbookDataCollection.xlsx
Temperature1.xlsx | Temperature2.xlsx .... TemperatureN.xlsx
Flow1.xlsx | Flow2.xlsx .... FlowN.xlsx
I have WorkbookDataCollection.xlsx collecting all data from the different Temperature and Flow data sheets, but since it only collect if they are opened I need a macro to open them all (The N stands for different amount of data workbooks) and after they are all opened to close them.. Lets say I have two of each, the process will be:
OPEN:
Temperature1.xlsx | Temperature2.xlsx | Flow1.xlsx | Flow2.xlsx -----> WorkbookDataCollection.xlsx
CLOSE:
Temperature1.xlsx | Temperature2.xlsx | Flow1.xlsx | Flow2.xlsx | WorkbookDataCollection.xlsx
Given there are random number of data workbooks, I think I would need some sort of loop.
Thanks in advance
Odracir
↧
September 15, 2015, 7:28 pm
Hi, I want to automate an event case log with the following -
1. When any text is entered into Cell A1, today's date is auto populated into Cell B1.
also
2. If there is data in A1, BUT no data in Cell C1, OR, D1, OR E1, the line is set to highlight red.
Any ides would be greatly appreciated.
↧
↧
September 15, 2015, 8:18 pm
Sort The value of cell. Sheet 1 is the list sheet 2 is the result that i want get. i do that in manual. any idea what code i need to use or macro codes. Anyone can help me please ? Thanks godbless
↧
September 15, 2015, 8:27 pm
Greetings Excel Forum Team!
Problem Statement: How to make multiple excel columns as non-editable in multiple Tabs using VBA
In the attached spreadsheet (Test-ColumCellNonEditable.xlsm - SEP-Test Tab)
I have column L with specific defined Range(L7 - L22) is made non editable when user clicks on Column L between L7 & L22.
--------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("L7:L22")) Is Nothing Then
Target.Offset(, 1).Select
MsgBox "Executed is Non-Editable"
End If
End Sub
--------------------------------
User Scenario1: Is it possible to make multiple columns with identified ranges such as below as non editable.
Column O Range(O7 - O22),
Column P Range(P7 - P22).
User Scenario2:If I have multiple Tabs like 'SEP-Test', 'AUG-Test' but each Tab need same columns (L,O,P)need to be non editable but range for each Tab varies
Is it possible to have single dynamic function that can handle above need, please let me know.
Appreciate any help with resolution(vba function/proc) for above User Scenario's.
Thank you.
↧
September 15, 2015, 8:36 pm
Is there VBA Code to change only one Pivot Field across multiple Pivot Tables on different sheets in the same workbook? Just tried doing this with a filter, but didn't like the layout. The field I want to update across all of the pivots is only Client Name. If I change another field say the Month in an individual pivot I don't want it to change in the others.
↧
September 16, 2015, 3:04 pm
Hey guys,
I am wondering if there is a way to call a database, get the recset, then insert a value from recset DIRECTLY into a named range in the workbook? I ask because the SQL string I am using will return ONLY ONE record...
Code:
SQL_SCORES = "SELECT YEARQTR, PO_NUMBER, DESCRIPTION, VENDOR, BUYER, COST, SCHEDULE, QUALITY, WEIGHTED_SCORE FROM WTP_SSRM_VENDOR_SCORECARD_V WHERE PO_NUMBER = '" & Response & "' AND YEARQTR = '" & YEAR_QTR & "'"
So, the above SQL will have one entry for YEARQTR, one entry for PO_NUMBER, all the way down the line... so I want to insert the value captured for COST, SCHEDULE, and QUALITY directly into their respective named ranges in the Workbook without having to paste the recset into a sheet.
Any ideas? Thanks.
EDIT: Solved! I believe... Here's what I did:
Code:
SQL_SCORES = "SELECT YEARQTR, PO_NUMBER, DESCRIPTION, VENDOR, BUYER, COST, SCHEDULE, QUALITY, WEIGHTED_SCORE FROM WTP_SSRM_VENDOR_SCORECARD_V WHERE PO_NUMBER = '" & Response & "' AND YEARQTR = '" & Year_QTR & "'"
recset.Open Source:=SQL_SCORES, ActiveConnection:=con
End With
recset.MoveFirst
MsgBox recset!Cost
The msgbox is populated with the correct value in this case.
↧
↧
September 16, 2015, 3:06 pm
in my excel i have 13 sheets. 12 Sheets are the months of the year from Apr to Mar and each sheet there is every thing what i have bought and sold, the last sheet is the Total so far
on VBA Sheet 1 is the Total and sheet 2 Apr to sheet 13 Mar
Purchased Date is column B from row 3 to row 46 and sold Date is column C from row 3 to row 46.
what i want to do is when i put the sold date will cut the row from that sheet and past it in to the right sheet
for example: i have bought a car in 04/07/2015 that will be in July sheet, i sold it in 01/09/2015.
i want it automatic cut
test 005.xlsxthe row from column A row to column I and paste it to the next available row of Sep as the car been sold in Sep.
↧
September 16, 2015, 3:17 pm
Greetings
I'm using the following code to download image files from the web.
The source of the file and the destination are stored on Sheet1 columns C and D
I'm stuck on how to trap the success or failure of each loop and color the cell accordingly
Code:
Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Private Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Public Function DownloadFile(sSourceURL As String, _
sLocalFile As String) As Boolean
DownloadFile = URLDownloadToFile(0&, _
sSourceURL, _
sLocalFile, _
BINDF_GETNEWESTVERSION, _
0&) = ERROR_SUCCESS
End Function
Private Sub CommandButton1_Click()
Dim sURL As String
Dim sLocalFile As String
Dim sDestination As String
Dim sText As String
Dim i As Integer
Dim ws As Worksheet
For i = 4 To 9
With ws
Range("B" & i).FormulaR1C1 = "Working...."
Range("B" & i).Interior.ColorIndex = 6
sText = Sheet1.Range("C" & i).Value
sURL = sText
sLocalFile = Sheet1.Range("D" & i).Value
DownloadFile sURL, sLocalFile
End With
'IF successful then
Range("B" & i).FormulaR1C1 = "Completed"
Range("B" & i).Interior.ColorIndex = 4
'Else
' Range("B" & i).FormulaR1C1 = "Failed"
' Range("B" & i).Interior.ColorIndex = 3
'End IF Next i
End Sub
↧
September 16, 2015, 3:22 pm
Hi,
how can i select cell after last used row. i am using this but its not working
Range("A" & Rows.Count).End(xlUp).Select
Thanks
↧