September 16, 2015, 4:18 pm
Hi I have a drop down menu with different dates.
Next to it I wrote all different dates in a column and next to it have a formula for different values based on the date and another input. If i change the other input I need to rechoose all different dates so that all values update. Is there a quick way for a macro to auto refresh the formula for all dates instead of me manually choose all of them?
↧
September 16, 2015, 4:24 pm
Title says it all. Stepping through the below code does as desire but running the macro doesn't. I am specifically having issues with the Else portion. This is what happens when I run the macro
CountA(Range("B2:B5")) currently equals 3 so goes to Else
Excel pauses for 5 seconds
then image "Dennis" flashes and disappears.
Running in step through (This is what I want)
CountA(Range("B2:B5")) currently equals 3 so goes to Else
Image "Dennis" appears
Excel pauses for 5 seconds
Image "Dennis" disappears
End
Thoughts?
Code:
Private Sub Image1_Click()
Application.ScreenUpdating = True
If Application.WorksheetFunction.CountA(Range("B2:B5")) = 4 Then
ActiveSheet.PageSetup.LeftFooter = Format(Now, "yyyy.mmm.dd HH:MM")
Sheets("Temp Logger|GPS Setup").Select
ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Ethan\Desktop\" & Sheets("Temp Logger|GPS Setup").Range("A1") & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Else
Shapes("Dennis").Visible = msoTrue
Application.Wait (Now + TimeValue("00:00:05"))
Shapes("Dennis").Visible = msoFalse
End If
End Sub
↧
↧
September 16, 2015, 5:04 pm
Hi there,
I have a macro that identifies all rows of data containing an expiry date effective today to 60 days from now, and copies those rows to a new worksheet. I want to filter all rows that contain an expiry date within an approximate two month range starting today. Unfortunately my code returns everything starting today and ignores part of the condition. I don't know if there is a problem with the date formatting though I've checked it. If there is a better way of coding this I would really love to know and all help is appreciated.
Code:
Sub SearchForExpiryDate()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 8
LSearchRow = 8
'Start copying data to row 2 in Expiring MOCs (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column H > Today, copy entire row to "Expiring_MOC"
If Range("H" & (CStr(LSearchRow))).Value > Now() And Range("H" & (CStr(LSearchRow))).Value < DateAdd("d", 60, Now()) Then
'Select row in MOC_MASTER to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into "Expiring_MOCs" in next row
Sheets("Expiring_MOCs").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to 'MOC MASTER' to continue searching
Sheets("MOC_MASTER").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
↧
September 16, 2015, 5:16 pm
Hi All,
i have a macro that works fine but i want to modify it, what i want is the same message to appear if it finds 1.4.3 or 1.4.4.
Not sure what to do, do i add "1.4.3","1.4.4" ?, any help would be appreciated.
Code:
Dim A As Range, r As Range
Set A = Range("f8:f1002")
If Intersect(Target, A) Is Nothing Then Exit Sub
For Each r In Target
If r.Value = "1.4.3" Then
MsgBox "message here."
End If
Next r
Thanks.
Top-Dad
↧
September 16, 2015, 6:16 pm
Hi all,
I'm relatively new to VB programming in Excel.
I was wondering if someone could help me modify the following script to
allow me to specify certain cells in an Excel Spreadsheet to output to an email as text or in a graphical format (not as an attachment) and then automatically send that email.
This would be to automate the sending of specific cells of an Excel Spreadsheet at a certain time each day as an email.
Code:
Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject as String
Dim strFrom as String
Dim strTo as String
Dim strCc as String
Dim strBcc as String
Dim strBody As String
strSubject = "Results from Excel Spreadsheet"
strFrom = "xxxxxx@xxxxxxxxx.net"
strTo = "xxxxxx@gmail.com"
strCc = ""
strBcc = ""
strBody = "" & Str(Sheet1.Cells(2, 1))
Code:
Set CDO_Mail = CreateObject("CDO.Message")
On Error GoTo Error_Handling
Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1
Set SMTP_Config = CDO_Config.Fields
With SMTP_Config
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.metrocast.net"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
With CDO_Mail
Set .Configuration = CDO_Config
End With
Code:
CDO_Mail.Subject = strSubject
CDO_Mail.From = strFrom
CDO_Mail.To = strTo
CDO_Mail.TextBody = strBody
CDO_Mail.CC = strCc
CDO_Mail.BCC = strBcc
CDO_Mail.Send
Error_Handling:
If Err.Description <> - Then MsgBox Err.Description
Your assistance is greatly appreciated!
↧
↧
September 16, 2015, 6:47 pm
Hello:
Please refer to attached file.
I have data in Sheet1 as shown. (Note the color in the Sales are due to Conditional formatting).
I need VB Code to copy data A1:F5 from Sheet1 and paste at cell A5 in "Backup" Sheet with the same color and format
but do not need Conditional formatting in Backup sheet.
Need to make sure that i get
Let me know if you have any questions.
Thanks.
Riz
↧
September 16, 2015, 6:53 pm
Can you please
time computation.xlsxhelp me make the macro for the block movement that I am working on.
If you open the spreadsheet attached you'll see this:
Column A is the letters
Column B is where the campaign will be printed
Column E is the campaign
Column F is where the campaign should go
What it should do first is that it will get the unique letters and the count it from column A, as an example is in Column I to K, once it found the unique letter, count of it and where is the row number of it. It will now print the Campaign in column B with the same times that is indicated in Column G.
I have did an example already in Column B, in this scenario Campaign 4 needs to be printed 5 times in letter A, thats why he was prioritized and was printed in 5 A's.
↧
September 16, 2015, 7:00 pm
I want all rows deleted expect those that have the word to in column a
↧
September 16, 2015, 8:13 pm
Hello,
My OCD has kicked in a day before I need this project done. I work for a snow removal company and have created an input sheet which then creates a proposal. I would like to have these switched over to VBA forms instead of the current set up to consolidate room on the sheet. Unfortunately, with marginal coding knowledge I will not be able to get this done.
If anyone would be kind enough to help me out with these forms I would greatly appreciate it!
Thanks in advance!!
Help Make Form1.xlsx
↧
↧
September 16, 2015, 8:40 pm
Hello,
When the user enters the record using a userform, it places the record at the first available row at the bottom. I would like to know if it's even possible to use a Macro to automatically alphabetize the rows of data predicated off of the First cell in the row?
Full Name Hire Date Quality Accuracy Base AHT MED AHT DMT ACW Floor Support Calls Floor Support AHT Department ADH VOC NPS Ind NPS Team FCR Team
Alexander, Michael 10/14/2012 99 99 496 496 496 47 5.0 5.0 CHDP - Cust Srv 83 5 0 0 50 Richter
Barger, Condance L 10/15/2012 99 99 496 496 496 47 5.0 5.0 CHDP - Cust Srv 83 5 0 0 50 Richter
Respectfully
John
↧
September 16, 2015, 8:47 pm
Hello
I need your valuable help
I have a macro with an The macro should count the amount of "R" in column J and place according to the Q column in the color matrix.
What should I do to fix the error caused by the combined cells and blank cells.
Thank you
MAP.xlsm.
↧
September 17, 2015, 1:17 pm
Hi, Can anyone tell me if it's possible to create a bit of code that will provide the
sum of 2 or 3 numbers within a cell separated by a space.
In the attached file there are 2 examples.
Example 1 shows the data i wish to ammend, specifically column F
In rows 3 and 5 we have cells with 2 numbers separated by a space that i would
like the sum of as shown in the completed data in example 2.
Any help would be greatly appreciated.
Regards
John
↧
September 17, 2015, 1:31 pm
For you newbies,
this is is something I struggle with a lot. -And you should look to master.
For the masters,
Help me nab this logic down...
Code:
l = Range("M" & Rows.Count).End(xlUp).Row
'The Data in column M will always have data in each row...NO blanks
So based on the lenght of Column M (Which starts on cell M8--Not sure if the above should show as M8:M)
Here is the line giving me trouble
Code:
Set sht = ThisWorkbook.Worksheets("Sheet1").Range("AC8").End(xlToRight)
I need to select AC8 and down to the length of column M or "l"
↧
↧
September 17, 2015, 1:31 pm
Hello All,
I have a decent understanding of excel. Notwithstanding, I am still a bit of a novice when it comes to VBA.
Here is my dilemma:
In an attempt to automate a query within one of my workbooks I recorded a simple macro to run/update said query. However, there is an issue... my query was setup in a way that always requires the end user to update the date range within the query. For example, when I want to update my data for the month of August 2015 I need to update the date range to 201508, which equals August 2015 in SQL language. So by default my recorded macro has a reference to a specific date for the query update, in this case 201508. I need to be able to update this date by simply referencing a cell in my workbook (let's say cell A1 on the worksheet tab) which will be the point of reference for my macro's date range. So if someone wants to see this information for September 2015 they can type in 201509 in a cell and run the macro for a quick update. I haven't decide on whether the macro will run when a date range is enter in the cell or if there will be a button. Regardless, any one have any ideas on how I can go about making changes to the below string to make this happen?
Code:
Sub Macro_IC_Invoice()
'
' Macro_IC_Invoice Macro
'
'
Range("A2").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
With Selection.ListObject.QueryTable
.Connection = Array(Array( _
"ODBC;DSN=Proddb - Live;Description=Live Production;UID=sa;Trusted_Connection=Yes;APP=Microsoft Office 2010;WSID=DAVA-BRDG-L;DATABAS" _
), Array("E=proddb;LANGUAGE=us_english"))
.CommandText = Array( _
"Select ad.accounting_period,ad.fiscal_per_nbr,ad.co_code,ad.org_code,ad.acct_code,ad.currency_code,ad.sys_doc_type_code,ad.usr_batch_id,ad.db_amt_ac,ad.db_amt_cc,ad.cr_amt_ac,ad.cr_amt_cc,ad.prj_code," _
, _
"fcs.trn_desc" & Chr(13) & "" & Chr(10) & "from Proddb..gl_acct_detail ad " & Chr(13) & "" & Chr(10) & "left join proddb..fcs_trn_desc fcs ON ad.fcs_desc_skey = fcs.fcs_desc_skey " & Chr(13) & "" & Chr(10) & "Where substring(ad.acct_code,1,1) in ('I','P','R') " & Chr(13) & "" & Chr(10) & "and ad.accounting_perio" _
, _
"d = 201508" & Chr(13) & "" & Chr(10) & "and ad.usr_batch_id not like ('RGL') " & Chr(13) & "" & Chr(10) & "and (ad.acct_code like '%731%' " & Chr(13) & "" & Chr(10) & "or ad.acct_code like '%711%')" & Chr(13) & "" & Chr(10) & "and ad.cr_amt_ac = 0" & Chr(13) & "" & Chr(10) & "" _
)
.Refresh BackgroundQuery:=False
End With
Sheets("IC Allocation Detail Query").Select
Range("A2").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
With Selection.ListObject.QueryTable
.Connection = Array(Array( _
"ODBC;DSN=Proddb - Live;Description=Live Production;UID=sa;Trusted_Connection=Yes;APP=Microsoft Office 2010;WSID=DAVA-BRDG-L;DATABAS" _
), Array("E=proddb;LANGUAGE=us_english"))
.CommandText = Array( _
"SELECT ad.co_code, ad.fiscal_per_nbr, ad.fiscal_year, ad.org_code, ad.acct_code, ad.db_amt_cc, ad.cr_amt_cc, ad.db_amt_ac, ad.cr_amt_ac, ad.alloc_co_code, ad.gl_alloc_code, ad.posting_date, ad.account" _
, _
"ing_period, ad.mod_date" & Chr(13) & "" & Chr(10) & "FROM Proddb.dbo.gl_alloc_detail ad" & Chr(13) & "" & Chr(10) & "WHERE (ad.acct_code Like '%731%') AND (substring(ad.acct_code,1,1) In ('I','P','R')) AND (ad.accounting_period=201508) OR (ad.acct_code Lik" _
, _
"e '%711%') AND (substring(ad.acct_code,1,1) In ('I','P','R')) AND (ad.accounting_period=201508)" _
)
.Refresh BackgroundQuery:=False
End With
End Sub
↧
September 17, 2015, 2:00 pm
Hey guys,
Have a feeling I'm over-complicating this one... I just want to loop through three different recordsets and dump one field.
I have the loop so it begins at i = 7, so we start at range B7 and move down to B8, and so on until we have moved down the number of records. please let me know if I can clarify:
Code:
Dim i As Integer
Dim j As Integer
Dim k As Integer
recset_cost_comments.MoveFirst
recset_quality_comments.MoveFirst
recset_schedule_comments.MoveFirst
i = recset_cost_comments.RecordCount
j = recset_quality_comments.RecordCount
k = recset_schedule_comments.RecordCount
Do While Not recset_cost_comments.EOF
For i = 7 To (7 + i)
ActiveWorkbook.Sheets("Cost").Range("B" & i).Value = recset_cost_comments!Comments
recset_cost_comments.MoveNext
Next i
Loop
Do While Not recset_quality_comments.EOF
For j = 7 To (7 + i)
ActiveWorkbook.Sheets("Quality").Range("B" & i).Value = recset_quality_comments!Comments
recset_quality_comments.MoveNext
Next j
Loop
Do While Not recset_schedule_comments.EOF
For k = 7 To (7 + i)
ActiveWorkbook.Sheets("Schedule").Range("B" & i).Value = recset_schedule_comments!Comments
recset_schedule_comments.MoveNext
Next k
Loop
The error I get is, "Either BOF or EOF is True, or the current record has been deleted". However, there is one record for the first recordset, 5 for the 2nd and 4 for the 3rd. To note, it does successfully write the one record before kicking out the error.
Any ideas? Thanks.
↧
September 17, 2015, 2:28 pm
Hi there
I'm looking to see if there is any VBA way in which I can copy the cell values from one column, where the values may have blank cells in between, to another column in a separate sheet but with no blanks. Example:
Sheet 1 Cell range A1 to A10, but only cells A1, A4, A5 and A7 have values
I want to be able to copy these to sheet 2 column, A but to start in the first cell (a1) and populate all sequential cells without blanks, in this example A1 to A4.
Further to this the values in sheet 1 are generated via formulas, and it's only the values I need to be copied, not the formulas or formatting.
The cell ranges used above are arbitrary, as ideally I need to be flexible on the choice of ranges used.
Hope that makes sense. Any help with this greatly appreciated :-)
↧
September 17, 2015, 2:35 pm
Hi,
I've got a problem with importing many *.csv files into Excell. After importing, it cuts off digits
after comma.
I added this formula, hoping that it will import those numbers properly, but it doesn't work.
Code:
'numberformat
Range("A:B").NumberFormat = "0.00"
Do you have any ideas how to do this?
Original CVS file:
"Dose cGy" "Volume %"
"0,0" "100,0"
"4,0" "99,92"
"5,0" "99,92"
"6,0" "99,83"
"7,0" "99,66"
After importing into Excel (of course without quotation marks):
"Dose cGy" "Volume %"
"0,00" "100,00"
"4,00" "99,00"
"5,00" "99,00"
"6,00" "99,00"
"7,00" "99,00"
Code:
Sub import_double()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
sDelimiter = ";"
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="CSV (*.csv), *.csv", _
MultiSelect:=True, Title:="Text Files to Open")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
x = 1
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
'numberformat
Range("A:B").NumberFormat = "0.00"
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, _
Other:=False, OtherChar:="|"
x = x + 1
While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
With wkbAll
kbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:=sDelimiter
End With
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
↧
↧
September 17, 2015, 2:51 pm
Hi there,
Can someone please show me how to tidy this up a bit, I feel it not efficient and maybe could use error handling as well.
Its just to force upper case in one cell and to force default values in various other cells that have dropdown lists, all on the same worksheet.
Many thanks in advance for any assistance :)
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
' Force upper case in a certain cell
If Not (Application.Intersect(Target, Range("C4")) Is Nothing) Then
With Target
If Not .HasFormula Then
Application.EnableEvents = False
.Value = UCase(.Value)
Application.EnableEvents = True
End If
End With
End If
' Force default values other than blank in certain cells that have dropdown lists
If Not Intersect(Target, Range("A7")) Is Nothing Then
If Range("A7").Value = "" Then
Range("A7").Value = "Default Text 1"
End If
End If
If Not Intersect(Target, Range("A10")) Is Nothing Then
If Range("A10").Value = "" Then
Range("A10").Value = "Default Text 2"
End If
End If
If Not Intersect(Target, Range("D6")) Is Nothing Then
If Range("D6").Value = "" Then
Range("D6").Value = "Default Text 3"
End If
End If
If Not Intersect(Target, Range("D8")) Is Nothing Then
If Range("D8").Value = "" Then
Range("D8").Value = "Default Text 4"
End If
End If
If Not Intersect(Target, Range("D10")) Is Nothing Then
If Range("D10").Value = "" Then
Range("D10").Value = "Default Text 5"
End If
End If
If Not Intersect(Target, Range("F14")) Is Nothing Then
If Range("F14").Value = "" Then
Range("F14").Value = "Default Text 6"
End If
End If
If Not Intersect(Target, Range("J14")) Is Nothing Then
If Range("J14").Value = "" Then
Range("J14").Value = 0
End If
End If
End Sub
↧
September 17, 2015, 4:05 pm
Okay folks I will try my best to explain what I am trying to do. I have a few different Game sheets that I have to fill out manually and would like to be able to hit perhaps add a sheet or click on a button and have a Macro copy and paste a new Game sheet with updated data on it. My rows go from high to low so where I start with data on row 2978 my sheet will go to row 1. From left to right the rows count up on the sheet but from Game to game they count down 2978-1. Imagine if I only had Game #24 and no Game #25. I want to click on a button or new tab and have it make the next game automatically like Game #25, then Game #26, #27 and so on So here goes.
I have my actual Game sheets uploaded so all the formulas in the sheet are true and actual
Game #24
A3:A31 row 2978 data within this book
L3:L31 row 2979 data within this book
W3:W31 row 2980 data within this book
G3:H31, R3:R31, AC3:AD31 data within this book
All yellow/Red and Gray/Green cells C:F, N:Q, Y:AB will have the same row numbers per Game sheet but from external books. These are the only ones that are from a linked sheet
Sections in rows 3-7 are called Numbers
Sections in rows 10-14 are called 50+ HITS
Sections in rows 17-21 are called OB HITS
C3:F31 data from row 2978 external linked books
N3:Q31 data from row 2978 external linked books
Y3:AB31 data from row 2978 external linked books
Rows 25-31 are for the Bonus Ball again the yellow / red, Gray / Green cells C:F, N:Q, Y:AB are from the external books
Row 25 Numbers
Row 28 50+ Hits
Row 31 OB HITS
If I am asking too much form anyone please say so or if this cannot be done thats cool too. I will continue to build these manually ug lol
Here is a sort of template I guess:
Game #24 Game #25
A3:A31 row 2978 from within this book A3:A31 row 2977 data from this book
L3:L31 row 2979 from within this book L3:L31 row 2978 data from this book
W3:W31 row 2980 from within this book W3:W31 row 2979 data from this book
G3:H31, R3:R31, AC3:AD31 data this book G3:H31, R3:R31, AC3:AD31 data this book
All yellow/Red and Gray/Green cells C:F, N:Q, Y:AB will have the same row numbers per Game sheet but from external books. These are the only ones that are from a linked sheet
Game #24 Game #25
C3:F31 data row 2978 external linked books C3:F31 data row 2977 external linked books
N3:Q31 data row 2978 external linked books N3:Q31 data row 2977 external linked books
Y3:AB31 data row 2978 external linked books Y3:AB31 data row 2977 external linked books
Bonus Ball Section yellow/Red and Gray/Green
E-O EO EEOO
Row 25 Numbers 2978 external link 2977 external link
Row 28 50+ Hits 2978 external link 2977 external link
Row 31 OB HITS 2978 external link 2977 external link
Thank you so much for your most valuable time in helping me!!
↧
September 17, 2015, 6:15 pm
I have a spreadsheet that has several columns. Column C will be full of numbers only but with the exception of some containing the letter "F". When column C is sorted, it will put all the F's at the bottom. I want the macro to first sort the spreadsheet by column C with headers in row 2 (which puts the F's at the bottom). The I want it to select the rows that don't have the letter F in column C (they will all be at the bottom), and sort them by column E. The number of rows with and without an F in that column is constantly changing as well. Is this possible? Thank you!
↧