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

Excel 2010 returns wrong .Shapes property values

February 11, 2014, 2:48 pm
$
0
0
The following code works in Excel 2003, but not in Excel 2010:

Code:
    mSheet = ActiveSheet.Shapes(Application.Caller).AlternativeText
The application dynamically creates several "buttons" on a worksheet and assigns them unique values to the .Name and .AlternativeText properties. The above code is executed when any of the buttons is pressed.

Under 2003, the above line of code retrieves the correct .AlternativeText value for the button pressed.

Under 2010, the above line of code retrieves the .AlternativeText value for the first button created, no matter which button is pressed. ...same for the .Name property.
↧
Search

[SOLVED] how to formula the filter for day of the week

February 11, 2014, 3:09 pm
↧
↧

auto fill date and time

February 11, 2014, 3:30 pm
$
0
0
Hi all

I would like to enter data in cell a and i would like cell b to automatically enter the date and cell c enter the time.
i would like this to do for rows 1 to 50
can any one help i am a novice at excel vba
↧

[SOLVED] Print All Macro Doing Weird Things.

February 11, 2014, 3:36 pm
$
0
0
My Original Print All Macro was created by a user named - fredlo2010
This worked great.
http://www.excelforum.com/excel-prog...ml#post3523418

I had some issues with my invoice coding, and user - hemesh
helped me out with this
http://www.excelforum.com/excel-prog...ml#post3581472

My issue is when I click the Print All Invoice macro it changes Sheet(Invoice) cells B2 and B31 to random customer names, where it should just stay
Pickup Location
also for some reason the very first page that prints, also prints again at the very end
None of these things happened before we did the code changes in the invoice
This was the code that was modified text in red is what was added, nothing else was changed that I'm aware of
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, targrow As Long, k As Integer, j As Long


    If Target.Address = "$B$4" And Target.Text <> "" Then
        With Sheet4
       
    Application.ScreenUpdating = False
   
            'Find the customer
            For i = 3 To .Range("B10000").End(xlUp).Row
                If .Range("B" & i) = Range("B4") Then
                    targrow = i
                End If
            Next
           
            'Clear the areas
            Range("C10:I15,C17").ClearContents
           
            'Find red entries and enter values
            k = 10
            For j = 3 To .Cells(targrow, 250).End(xlToLeft).Column
                If .Cells(targrow, j).Font.Color = 255 And .Cells(targrow, j).Value <> "" And .Cells(targrow, j).Value <> 0 Then
                    Range("I" & k) = .Cells(targrow, j)
                    Range("C" & k) = .Cells(2, j) & " Trash Collection"
                   
                    k = k + 1
                   
                    If k > 15 Then
                        MsgBox "You should stop working for this customer." & vbNewLine & vbNewLine & _
                        "Customer still owes you on older payment/s.", vbOKOnly, ("Call Customer !")
                            Range("C17") = "Your account is in arrears"
                    End If
                End If
            Next
        End With
      ElseIf Target.Address = "$B$4" And Target.Text = "" Then Range("C10:I15,C17").ClearContents
    Application.ScreenUpdating = True
    End If
    If Target.Address = "$B$33" And Target.Text <> "" Then
        With Sheet4
        Application.ScreenUpdating = False
            'Find the customer
            For i = 3 To .Range("B10000").End(xlUp).Row
                If .Range("B" & i) = Range("B33") Then
                    targrow = i
                End If
            Next
           
            'Clear the areas
            Range("C39:I44,C46").ClearContents
           
            'Find red entries and enter values
            k = 39
            For j = 3 To .Cells(targrow, 250).End(xlToLeft).Column
                If .Cells(targrow, j).Font.Color = 255 And k <= 44 And .Cells(targrow, j).Value <> "" And .Cells(targrow, j).Value <> 0 Then
                    Range("I" & k) = .Cells(targrow, j)
                    Range("C" & k) = .Cells(2, j) & " Trash Collection"
                   
                    k = k + 1
                   
                    If k > 44 Then
                        MsgBox "You should stop working for this customer." & vbNewLine & vbNewLine & _
                        "Customer still owes you on older payment/s.", vbOKOnly, ("Call Customer !")
                      Range("C46") = "Your account is in arrears"
                    End If
                End If
            Next
        End With
      ElseIf Target.Address = "$B$33" And Target.Text = "" Then Range("C39:I44,C46").ClearContents
    Application.ScreenUpdating = True
    End If
   

End Sub
also note that is cells I4, I33 are customer numbers, they are hidden because they where of no need to me but the print might be linked to them
I have attached the sample worksheets because its something you have to see to understand
Test 2.xls

any and all help if very appreciated
↧

Clear Contents of a column in a range variable

February 11, 2014, 3:39 pm
$
0
0
im sure this is easy but I cant figure it out.
I have a range variable named data I want to clear all the data in the 3rd column in the range variable I know how to reference a single location in the range variable but not a whole column. see example code below
Code:
Dim data as Range
Set data = Range("A1:D20").Value
data(1,3) = ""  'how would I change that so that all of the 3rd column is nothing
thanks for any help on this.
JD
↧
↧

Help merging duplicate entries with unique information

February 11, 2014, 3:56 pm
$
0
0
Hi,

I am trying to combine duplicates entries in one column, while preserving the unique information in each row from the duplicate.

A1; B1; C1
A2; B2; C2
A3; B3; C3

into this:

A1; B1; C1; B2; C2; B3; C3

So that if A1=A2=A3 and they are therefore duplicates, it will combine the information in each row by adding a new column.

I actually have a larger data set (i'm talking hundreds of thousands of entries) that I need to do this with.

I attached a snippet of it. I am trying to merge any duplicates from the first column (Desy_Sort_key) so that there are only unique numbers there, but without losing information from the other columns.

Thanks!
Attached Files
↧

Please explain the pieces of this code

February 11, 2014, 4:06 pm
$
0
0
Hello. Could someone please explain each piece of this code? Someone recommended stepping through it, which I did, but that doesn't help you learn if you don't know what the stuff means. A lot of the code action is behind the scenes.

Code:
Sub transe()

 Dim a, z, i As Long, j As Long, Y, n&, x, k, jj&
 Const delim As String = ","
 
 With Sheets("Sheet1")
  a = .Range("A2").CurrentRegion
 End With
    With CreateObject("Scripting.Dictionary")
      .comparemode = 1
        ReDim Y(1 To UBound(a, 1), 1 To 2)
      For i = 2 To UBound(a)
            If Not .exists(a(i, 1)) Then
                      ReDim z(1 To UBound(a, 2))
                      For j = 1 To UBound(a, 2)
                          z(j) = a(i, j)
                      Next
                      .Item(a(i, 1)) = Join(z, delim)
                  Else
                      ReDim z(1 To UBound(a, 2))
                      For j = 2 To UBound(a, 2)
                          z(j) = a(i, j)
                      Next
                      .Item(a(i, 1)) = .Item(a(i, 1)) & "," & Join(z, delim)
            End If
      Next
      z = .items
        For i = 0 To UBound(z)
              x = Split(z(i), delim)
                n = n + 1
                jj = 0
              For k = 0 To UBound(x)
                If x(k) <> vbNullString Then
                    If jj >= UBound(Y, 2) Then ReDim Preserve Y(1 To UBound(a, 1), 1 To jj + 1)
                    jj = jj + 1
                    Y(n, jj) = x(k)
                End If
              Next
            Next
                With Sheets("Sheet2")
                    .UsedRange.Offset(1).ClearContents
                    .Range("A2").Resize(n, UBound(Y, 2)) = Y
                    .Columns.AutoFit
                End With

 End With
End Sub
↧

searching col / array for value greater than (less than) reference value

February 11, 2014, 4:53 pm
$
0
0
Have not played with VBS in a long time so I'm a bit rusty.

To properly describe the problem here's sample data:
c d e f g
15.6 16 15.48 15.58 15064800
15.84 16.17 15.29 16.03 19420500
16.39 16.53 15 16.14 18822900
15.99 16.02 15.2 15.26 11079900
15.28 15.53 15 15.06 9578000
15.12 15.34 14.71 14.89 8335100
15.01 15.06 14.79 14.93 9626900
14.54 15 14.5 14.96 9536100
14.86 15.08 14.15 14.17 20721400
14.38 14.93 14.13 14.87 13541100
14.56 15.06 14.52 14.8 10398400
14.89 14.99 14.16 14.17 9668000
14.37 14.63 13.62 13.66 13810900
13.33 13.58 12.49 12.97 21110700
13.14 13.23 12.26 12.28 19419100
11.97 12.72 11.5 11.53 25008900
11.6 11.87 10.98 11.01 17938500
10.31 11.25 10 11.08 32782400
11.62 11.9 11.13 11.74 16953300
12.08 12.23 11.17 11.3 17192200
11 11.06 10.1 10.12 15280900
10.08 10.64 9.69 10.56 20180200
10.29 10.71 10.07 10.45 14347000
10.56 11.14 10.5 11.13 12694500
10.56 11.05 10.5 10.51 10286900
10.24 10.49 9.76 9.99 14840600
10.03 10.3 9.75 10.26 17700100
9.16 10.07 9.16 9.68 13519000
9.3 10 9.3 9.59 10134200
9.8 10.9 9.5 10.86 15730700
10.85 11.81 10.65 11.33 20073100
11.85 12.7 11.46 12.62 19678100
12.52 13.18 12.29 13.13 18683300

The macro setup starts:
Code:
Sub S10Pct()
Range("C2", "C600").Select
Set RangeToSearch = Selection
m10 = 0.9 * Range("C1").Value
I am trying to find in column C the first value less than 90% of C1. None of Vlookup, Index/Match, Find get me there. I am trying to avoid the inefficiency of loops as the data is massive.
I'll also be looking for 120% and various other similar items in other columns.

Suggestions towards solving the puzzle would be much appreciated. If I have no other choice I'll loop :(

Thank you,
LeonW
↧
Search

Paste Excel chart with embeded workbook for Mac

February 11, 2014, 4:57 pm
$
0
0
Hi

The following VBA code pastes Excel graphs to PowerPoint with the workbook embeded (same as clicking Paste Special -> Keep source formatting and embed workbook.

Can anyone assist in translating this code into Excel for Mac 2011? It breaks on "ExecuteMso"

Code:
Public PPApp As PowerPoint.Application
Public PPPres As PowerPoint.Presentation
Public PPSlide As PowerPoint.Slide

Sub ExcelToExistingPowerPoint()
    ActiveSheet.Select
    ActiveSheet.Copy
    ActiveSheet.Shapes(xChart).Copy
    Set PPSlide = PPPres.Slides.Add(PPPres.Slides.Count + 1, 2)
    PPSlide.CustomLayout = PPPres.Designs(1).SlideMaster.CustomLayouts(2)
    PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
    PPSlide.Shapes.Placeholders(3).Select msoTrue
    PPApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
End Sub
Thanks in advance!
↧
↧

Macros Error 1004

February 11, 2014, 5:22 pm
$
0
0
Let me start by saying I don't really have any idea what I'm doing with Macros. I'm somewhat excel savvy but this is a totally different ball game. I copy and pasted a formula from another thread from earlier and was really hoping I'd be able to use that method to achieve my end goal. My task is VERY simple. I just want to be able to click a cell and have a check box appear and the date and time appear next to it (I wanted the check and the date and time all in one cell, but hey beggars can't be choosers!). So for the first half of my day this formula was working:

PHP Code:
Option Explicit
Dim lrow As Long

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    lrow = Cells(Rows.Count, 1).End(xlDown).Row

    If Target.Cells.Count > 1 Then Exit Sub

        If Not Intersect(Target, Range("B3:B" & lrow)) Is Nothing Then

            Target.Font.Name = "Marlett"

                If Target = vbNullString Then

                    Target = "b"

                Else

                    Target = vbNullString

                End If

        End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Range("B3:B" & lrow)) Is Nothing Then
        If Target.Value = "b" Then
            Target.Offset(0, 1).Value = Format(Now, "dd/mm/yy,hh:mm")
        End If
    End If

End Sub 
However... I'm now getting this error:

error.PNG

I've attached the file so whoever is willing to take a crack at it can see what I'm shooting for. I appreciate the help!!

VBA Test.xlsm
↧

Paste to last row does not work

February 12, 2014, 1:27 pm
$
0
0
Hello All,
Please take a look code then help me to fixit to paste to last row at column A Sheet2:

Code:
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Dim Lr1 As Long, Lr2 As Long
Lr1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
Lr2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row

    ActiveSheet.Range("$A$1:$BD$" & Lr1).AutoFilter Field:=40, Criteria1:= _
        "Fails"

    ActiveSheet.Range("$A$1:$BD$" & Lr1).AutoFilter Field:=16, Criteria1:="=OK1", _
        Operator:=xlOr, Criteria2:="=OK2"
       
If ws1.Range("A" & Rows.Count).End(xlUp).Row > 2 Then

ws1.Range("A2:BD" & Lr1).SpecialCells(xlVisible).Select
Selection.Copy Destination:=ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Regards,
tt3
↧

Round CommandButton in Userform?

February 12, 2014, 1:28 pm
$
0
0
Hi Experts,

Is it possible to have a round commandbutton in userform? If yes, could you please provide me an example?
↧

isDate - excel form -VBA

February 12, 2014, 1:52 pm
$
0
0
Hi there,

I am wanting to add some data validation to my excel form. It is meant to be a check on date.

Code:
Private Sub textbox17_gp_date_change()
If Me.TextBox17_test_Date.Value = vbNullString Then Exit Sub
    If Not IsDate(Me.TextBox17_test_Date.Value) Then
        MsgBox "Sorry, only date format in dd/mm/yyyy", vbCritical, "Data Validation"
        Me.TextBox17_test_Date = vbNullString
    End If
End Sub
when I run the form by putting in say...04/01/2012, it gives me that prompt saying invalid date.

Is there a way around this?

Thanks
↧
↧

Exporting selected worksheets

February 12, 2014, 2:01 pm
$
0
0
Hello All,

I have a master workbook with about 8 different reports. On the Input worksheet there is an option for which sheet you would like to export. The checkmarks are then linked slightly below on the Input worksheet in cells I29 to I38 is the output of those checkmarks. How do I get my macro to export only the worksheets that have a checkmark?

Here is what I have tried. A really long nested IF function that checks IF I29 (BS_Entity) is checked, then export to a new workbook. That new workbook is then DIMed and labeled as NewEPwb, while the current workbook is called EPwb. The problem is it gets very messy with 8 nested IF functions, because then you have to worry about IF true & If false 8 times. 2 powered to the 8 equals 256 possible scenarios lol I imagine there is a much easier way to do this then to write my code 256 times.. Below you will find my code. Note I only am in the testing stages and have done it for about 4 worksheets, still need to add the rest.

Thank you!

http://i770.photobucket.com/albums/x...ps4bf0a42a.jpg

http://i770.photobucket.com/albums/x...ps743bcf7c.jpg



Code:

Sub Individual()
'

Dim rs As Worksheet
Dim SPcheck As Range
Dim Ncheck As Range
Dim SPNcheck As Range
Dim EPwb As Workbook
Dim NewEPwb As Workbook
Set EPwb = ActiveWorkbook
Set SPNcheck = Sheets("Input").Range("I24")
Set SPcheck = Sheets("Input").Range("I25")
Set Ncheck = Sheets("Input").Range("I26")


If Sheets("Input").Range("I29") = True Then
  Sheets("BS_Entity").Select
    Range("G10").Select
    ActiveCell.FormulaR1C1 = "=Input!R[-5]C[1]"
    Range("G11").Select
   
    Sheets(Array("BS_Entity")).Select
    Sheets(Array("BS_Entity")).Copy
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D1").Select
   
Set NewEPwb = ActiveWorkbook
 
EPwb.Activate
If Sheets("Input").Range("I31") = True Then
  Sheets("IS_Entity").Select
    Range("G10").Select
    ActiveCell.FormulaR1C1 = "=Input!R[-5]C[1]"
    Range("G11").Select
   
    Sheets(Array("IS_Entity")).Select
    Sheets(Array("IS_Entity")).Copy After:=NewEPwb.Sheets(1)
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D1").Select
   
 EPwb.Activate
 
If Sheets("Input").Range("I33") = True Then
  Sheets("NOA").Select
    Range("G10").Select
    ActiveCell.FormulaR1C1 = "=Input!R[-5]C[1]"
    Range("G11").Select
   
    Sheets(Array("NOA")).Select
    Sheets(Array("NOA")).Copy After:=NewEPwb.Sheets(2)
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D1").Select
   
  EPwb.Activate
 
If Sheets("Input").Range("I34") = True Then
  Sheets("NOA_Entity").Select
    Range("G10").Select
    ActiveCell.FormulaR1C1 = "=Input!R[-5]C[1]"
    Range("G11").Select
   
    Sheets(Array("NOA_Entity")).Select
    Sheets(Array("NOA_Entity")).Copy After:=NewEPwb.Sheets(2)
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D1").Select
   
  EPwb.Activate
 
 End If
 End If
 End If
 End If
   
 
    Dim strPath2 As String
    Dim strFolderPath2 As String
   
   
        strFolderPath2 = EPwb.Sheets("Input").Range("H15").Value
        strPath2 = strFolderPath2 & _
            Sheet1.Range("H5") & " - " & Sheet1.Range("C7") & " " & Sheet1.Range("C8") & ".xlsx"
        NewEPwb.SaveAs Filename:=strPath2
   
        NewEPwb.Close
        EPwb.Sheets("Input").Select

   
   
   
End Sub
↧

Four MultiSelect Listboxes and TextBoxes: Advise No Selection/Entry Made, Return to Form

February 12, 2014, 2:23 pm
$
0
0
Hello Forum,

Thank you in advance.

I have an ActiveX userform that has a single frame with 4 multiselect listboxes, 4 textboxes, update command button to send info to worksheet, command buttons to close or refresh the form. If the user does NOT make any selections from the 4 multiselect listboxes OR does NOT enter anything in one of the 4 textboxes, they should receive a message alert when they click the update command button that is coded to send entries to the target Excel worksheet. That's a problem if they send blank entries and it overrides any current entries that exist in the worksheet.

So the flow of the code should be something like this when they click the command button (maybe the last steps are reversed?):
  1. Validation: check to see if there are ANY selections in ANY multiselect listbox OR entries in ANY textbox within the frame (or userform)
  2. If result is FALSE, pop a message box stating something like "No entries made, return to the form and make entries or use the X button to close form with no changes" and have the code stop there
  3. If condition is TRUE, then continue with the code I have to send the selections to the target cells in the worksheet.

I've searched all day and posted this thread earlier this morning with a different approach that is not as clean by disabling the update command button (didn't get a completely working solution there either). It feels as though my stumbling block is having multiple multiselect listboxes. I've seen many posts for checking for selections for 1, but not more than that.

Any suggestions as always are much appreciated!

Thanks,
Chris
↧
Search

Delete Comment once cell has been populated

February 12, 2014, 2:54 pm
$
0
0
Hi.
Is it possible to have a code that will remove the 'comment' from an Excel cell once that cell has been populated.
I have a number of cells that have a comment explaining to an operative what is required in the cell.
Once the operative has populated the cell with the required information, I would like the cell to have the comment deleted.
Thank you in advance for any help you can offer me.
↧

Copy & Paste Contents Multiple Sheets

February 12, 2014, 2:59 pm
$
0
0
I had this sheet up a few days ago and I got a quick response. I need to add sheets to the equation though. I would like to select a month from a drop down and the result would copy and paste the whole row of all of the sheets (3 sheets).

I enclosed an example.

Thanks for the help.

Copy & Paste.xlsm
↧
↧

Delete user chosen row and copy and paste data from below to deleted line

February 12, 2014, 3:11 pm
$
0
0
Hi,

I have a drop-down menu that allows the user to choose a vendor. I just added a delete button but I can't get it to work right. I would like the user to choose a vendor from the drop-down menu and then there is a separate button to delete the vendor. I have a lot of formula references on my sheets so if I delete something, I get the "#ref!" abbreviation. I want to try to clear the row the user selects and then copy and paste the data from the rows below to where the clearcontents row is. I also have a line number at the end of the row (U11:U) that works with the combobox to make the user's selection. This is the code I have so far:

Sub btest1()

Dim lastrow As Long
Dim strID As String
Dim strLine As String
Dim WS As Worksheet
Dim rngFound As Range
Dim rng As Range
Dim ab As Long


Set WS = ThisWorkbook.Worksheets("vendor")
lastrow = WS.Range("U" & WS.Rows.Count).End(xlUp).Row
strID = Right(Me.cmbVendorName, Len(Me.cmbVendorName) - InStrRev(Me.cmbVendorName, "-") - 1)
Set rngFound = WS.Range("u11:U" & lastrow).Find(what:=strID)
ab = rngFound.Row

Range(Cells(ab, 2), Cells(37, 21)).Select
Selection.Copy
Cells(ab + 1, 2).Select
Selection.PasteSpecial Paste:=xlPasteAll
End Sub
↧

Cannot get a row count from one worksheet and returned to another

February 12, 2014, 3:11 pm
$
0
0
I have a raw data workheet, I want to get the total count of rows from column A and return that count to my Daily numbers worksheet starting at K2. I also need it to continue to populate down column K by the date. (Everyday I run a report, and I need the row count to populate on the daily numbers worksheet in column K, ex K2 will be todays date, then tomorrow I will run the report and that will be on k3, I have tried quite a few macros and do not seem to have any luck. I am learning this on my own, and have all of the macros I need created, except this one. Can you help?
↧

last row used help

February 12, 2014, 3:17 pm
$
0
0
Hello. Why does the last "row" return the value of the row? Wouldn't it be "row" first and then "xlup"?

Code:
lngLastRow = Range("F" & Rows.Count).End(xlUp).Row
↧
Viewing all 50236 articles
Browse latest View live
Search