Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all 49833 articles
Browse latest View live

[SOLVED] Create Dynamic Text Box (TextBox1_Change)

$
0
0
I would like to re-create the spreadsheet attached.

How was the text box created in cell A1? Is this activeX? Please walk me through the steps to create.

The macro is pretty straight forward, no help needed there.
Attached Files

Format Number with Macro

$
0
0
I have an Access database where the number format of several columns is field size=double decimal places=auto

My Excel Macro where I format the cells is:

Code:

  Columns("A:B").Select
    Selection.NumberFormat = "0"

When I import the Excel sheet, it changes the 2 columns to field size=double format=0 decimal places=auto.

Because of this, the DBA cannot simply append my data on the import because she gets a key violation. How do I alter my macro so it will just mirror Access?

merging first sheet of several workbooks saved in one file

$
0
0
Hello, does anyone know how to fix this macro so that the new sheet opens up in the same workbook that the macro is running on? Also, is there a way for it to copy the formulas associated with the cells?




Function RDB_Last(choice As Integer, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
Dim lrw As Long
Dim lcol As Integer


On Error Resume Next
lrw = rng.Find(What:="*", _
after:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0

On Error Resume Next
lcol = rng.Find(What:="*", _
after:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0

On Error Resume Next
RDB_Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
RDB_Last = rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0


End Function


Sub last_cell()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
Dim FirstCell As String


'Fill in the path\folder where the files are
MyPath = "\\accounts\hcs\CMF\Public\Medical\Physical Therapy\Malpartida, M\Master"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then

On Error Resume Next

With mybook.Worksheets(1)
FirstCell = "A2"
Set sourceRange = .Range(FirstCell & ":" & RDB_Last(3, .Cells))
'Test if the row of the last cell >= then the row of the FirstCell
If RDB_Last(1, .Cells) < .Range(FirstCell).Row Then
Set sourceRange = Nothing
End If
End With

If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
'if SourceRange use all columns then skip this file
If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0

If Not sourceRange Is Nothing Then

SourceRcount = sourceRange.Rows.Count

If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "Sorry there are not enough rows in the sheet"
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else

'Copy the file name in column A
With sourceRange
BaseWks.Cells(rnum, "AZ"). _
Resize(.Rows.Count).Value = MyFiles(Fnum)
End With

'Set the destrange
Set destrange = BaseWks.Range("B" & rnum)

'we copy the values from the sourceRange to the destrange
With sourceRange
Set destrange = destrange. _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value

rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If

Next Fnum
BaseWks.Columns.AutoFit
End If

ExitTheSub:
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With

End Sub

Hide and Password Protect a Worksheet(s)

$
0
0
I have a workbook which I share both with my clients and my sub-contractors. I would like to be able to hide certain worksheets from view, but then also password protect them so only I can un-hide the sheets.

For example, for the attached workbook I would like to hide and password protect Client Billing Sheet.

Is there a simple code for this?

Pivot maco

$
0
0
Hi,

I am trying to create a pivot table using Macro. the code working fine.. but the "values" field in "Row label" insted of "column label.

Can any one help me this.

i have attache the excel file..

* Out put sheet contains actual output i need
*Information sheet contains, the information which need to be pivot.
*pivot sheet contains the macro output...

Thanks

Regards

Jack
Attached Files

Psasword rules

$
0
0
Hi

I want to impose few restriction while i am creating a login screen

a) the first letter cannot be a number
b) there can be no space in the password
c) the password needs to be atleast 8 character long
d) The password should be combination of number and alphabets


Is there a code for the same ??

VBA to upload exported PDF from Excel to sharepoint

$
0
0
This section code works to save a PDF to a file on our shared drive but not to the SharePoint site. I have access to the site and have loaded excel files using code.


Code:

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="http://Our sharepoint site.com/Shared Documents/" & name1 & " " & name2 & " " & name3 & " " & Format(Date, "MMDDYY") _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=True

Thanks,

Lotto triplets,quads and more

$
0
0
:confused:HELLO PLS VBA CODE FOR THIS FILE EXAMPLE EXTRACT TRIPLES: 1,4,6 OR 2,9,48

AND I MUST 4-6DIGITCODE TO EXTRACT EXAMPLE 1,4,6,12 1,4,6,12,15 1,4,6,12,15,18 PLS

https://www.dropbox.com/s/0ksum9oewkxuw7o/200test.xlsx

THIS MACRO IS FOR TRIPLES

Sub blah()
Set d = CreateObject("Scripting.dictionary")
Set cll = Range("A1")
Dim X()
Do
xx = Split(Application.Trim(cll.Value))
Debug.Assert UBound(xx) = 5
If UBound(xx) = 5 Then
For I = 0 To 3
For j = I + 1 To 4
For k = j + 1 To 5
Smaller = Application.Min(xx(I), xx(j), xx(k))
Larger = Application.Max(xx(I), xx(j), xx(k))
Middle = Application.Median(xx(I), xx(j), xx(k))
thisTriplet = Format(Smaller, "00") & "," & Format(Middle, "00") & "," & Format(Larger, "00")
If d.Exists(thisTriplet) Then
d.Item(thisTriplet) = d.Item(thisTriplet) + 1
Else
d.Add thisTriplet, 1
End If
Next k
Next j
Next I
End If
Set cll = cll.Offset(1)
Loop Until IsEmpty(cll)
ReDim X(1 To d.Count, 1 To 2)
I = 0
For Each p In d.Keys
I = I + 1
X(I, 1) = p
X(I, 2) = d.Item(p)
Next p
Set rngResults = Range("C2").Resize(d.Count, 2)
rngResults.Value = X
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=rngResults.Columns(2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.SortFields.Add Key:=rngResults.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rngResults
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Export Image Issues

$
0
0
All-

I am using the below code to export an image of a range. It works perfectly, except for the fact that it comes out as a picture of my range over top of a chart of the data in the range.

How do I do get this to only export the picture of the range?

Any help would be greatly appreciated!


Code:

Sub RangePic()

Worksheets("NewRepScoring").Range("A1:Q17").CopyPicture xlScreen, xlBitmap

Application.DisplayAlerts = False
Set oCht = Charts.Add
With oCht
.Paste
.Export Filename:="\\portal\DavWWWRoot\cwie\sales\business\QA%20Pages\RepDashboard.png", Filtername:="PNG"
.Delete
End With
End Sub

How to copy paste specific cells is a condition is met

$
0
0
HI,

I am pretty new to VBA. I would be very grateful if you could help me create a macro to copy cells for data starting from A4 to N4 from sheet - Register to 'Case History' when the cells in column N are 'Yes'. Also, would like to copy specific range from A-N and not the entire row. Please refer to the attachment.

It would be great if you could help me asap.

Tracker Dept..xlsx

VBA ".End(xlDown)" with formulated cells

$
0
0
Hello,

So I have this code which works for non formulated columns:

Code:

Sub ADIMMSTRANSITCOPY()
Sheets("ADI MMS").Select
With Range("F2")
Range(.Cells(1, 1), .End(xlDown).Cells(1, 1)).Copy
End With
End Sub

I wanted to create another for Column "AH" and start copying from "AH2" until the blank. However Column AH is formulated so it's taking all of the formulated cells.
For reference, the formula series in AH is:
Code:

=IFERROR(VLOOKUP(Q3,{"Cancelled",90;"Drive By",200;"Full Appraisal",300;"RPM",750;"Appraisal Update",150},2,0),"")

I'm looking for help to convert above VBA to say: Copy all column "AH" from "AH2" until there's actually no value from the formula above.


Your help is greatly appreciated.
Thank you!

Opening Previous Day File by Filename

$
0
0
Hello Everyone,

As part of a larger macro, I would like my code to open a previous day's workbook and then copy data in to the macro workbook. I should be okay to write the copying data to the macro workbook part, but I was hoping for a little help on the best way to open the previous day's workbook.

For example, since today is March 13, 2014, I would want to open yesterday's workbook. The path and filename would be as follows:

C:\Home\Numbers\Reconciliation\March_2014\Freybe06_summary_2014312.xlsx

If there is any way for the macro to look at the most recent file, that would probably be best because then it can't account for weekends, holidays, switching to a new month, etc.

Please let me know if you have any questions.

Thanks in advance!

FileDialogFilePick a file, then get the folder path

$
0
0
Hi,

I have what is certainly a very basic question, but which stuck me for hours (not totally lost since I learned quite few interesting things while digging around for the answer ;))

Once a file has been selected, I need to extract the path to go to the parent folder. In the code below, I have removed everything not relevant to my project, so that my problem will hopefully be clear.
I have a way to do it, by removing the n+1 characters from the right of the total path (filename included, n being the length of the filename) but this is not elegant and certainly not the way to do it.

Thank you for your time!


Code:

Sub Test_Get_Info()

Dim FilePath As String, FileToOpen As String

    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "C:\"
        .AllowMultiSelect = False
           
            If .Show = True Then
                            FileToOpen = .SelectedItems(1)
                            FilePath = '.... (if file picked is C:\Temp\test.xls, FilePath should return: 'C:\Temp'
                            Else: MsgBox "No file specified.", vbExclamation, "CANCEL"
               
            End If
         
        MsgBox FilePath & Application.PathSeparator
    End With

End Sub

Return the directory/folder of the active file

$
0
0
Hi Folks!

Not much of a programmer and need some help.

I want to put a button on my toolbar that when clicked will return the directory/folder name of the active file into cell A1.

I know I can do this with a formula but I don't want to go that route. I would like some VBA code to do this.

Any help is greatly appreciated!

Calculate the Mean Absolute Error Using VBA

$
0
0
Hi Everyone,

I'm trying to develop a VBA Function that can calculate the mean absolute error of a range of values. the way the funtion would need to do is the following:

1. There are two columns of data; Column A and Column B. Both Columns have the same number of rows of data.

2. For every row of data the function would need to do Column A - Column B, take the absolute value of the result, and store it in an Array

3. The function would then calculate the average of all the values in the Array, and return a result.

Would anyone know how to do this?

Thanks.

Application-defined or object-defined error

$
0
0
Hello,

I would like to do the following calculation with and "if" function but I recieve the above error message..

I would appreciate if somone could help.


Sub calc()

If Cells("D7").Value = "USD/JPY" Then

Cells("I7") = Cells("C13") * Cells("H7")

End If

Best Regards,

Endre

Macro to copy paste data as transpose and to send email

$
0
0
Hi Team

I need to create a macro as follows

My data

Client Versionref Product Emailid
A 1 EL abc@gmail.com
A 10 PL abc@gmail.com
A 18 CL abc@gmail.com
B 8 CCI efg@gmail.com
B 6 EL efg@gmail.com

What I want

The above values needs to be copy pasted in a new workbook as follows
Client EL PL CL
A 1 10 18
Mail Sent Yes Yes YEs ----- This row is standard text for all

the above file should be saved under Temp file by client name and gets emailed to abc@gmail.com through macro

same for client B
Client CCI EL
B 8 6
Mail sent Yes Yes

the above file should be saved under Temp file by client name and gets emailed to efg@gmail.com through macro

Is it possible to do through macro?

Thank you

Transfer Dada From ISeries Button On Sheet (Not ToolBar)

$
0
0
I am looking to create a form button in Excel 2010 that runs a .tto file. I have an add-in for Excel 2010 called "Transfer Data From Iseries" The .TTO file is a definition file of files, SQL, etc. What I need is a button on the screen (I do not want to try to explain to 1K users on how to add an add-in in Excel. When you click on the button it should open the transfer dialog box and then they put in a userid/password and it populates within that Excel file.

I tried to record a macro to get the script, but it does not record this information. I also tried to use Insert > Object in excel and it works, except that it does not open the data into that specific excel file (the one that you are in).

Thank you for your help on this important problem.

Radical ROM

Add 0 if parameters are met

$
0
0
I am trying to add a 0 if it is missing at the start of the number in columns K2:K3000 and L2:L3000, The numbers do not have fixed lengths so I cant use the custom setting but if the number starts with a 7, 8 or 3 I want to add a 0, Is this possible?
Thanks
Johnny

How to make one ActiveX button select another?

$
0
0
Let's say in Sheet1 I have an activeX button "OptionButton1". Once selected, I want it to automatically select another ActiveX button which lives in Sheet2, called "OptionButton15". What code should I use under "OptionButton1"?

Thanks in advance!
Viewing all 49833 articles
Browse latest View live