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

Navigate in Header of word with Excel VBA

September 12, 2016, 5:02 am
$
0
0
Dear,

I am hoping that you guys can help me with the following: I borrowed an excel macro which makes it possible to navigate in a word file. But i would like to also navigate in the header/footer of microsoft word.

The code I am borrowing to navigate in the word file is:

Sub EditwordFile()


Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open("FILENAME")
wrdApp.Visible = True
With wrdDoc


.Application.Selection.Find.Text = "aanvraagbrief"
.Application.Selection.Find.Execute

'now found, lets insert text after
.Application.Selection.InsertBefore "hello there!"

End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub

I hope you can guys can help me.

Greetings Baran
↧
Search

HELP ME ! Create a program that Popup MsgBox in specific dates

September 12, 2016, 7:22 pm
$
0
0
I need a program that create Alert Box or MsgBox when date hired is 90 days past.

Thank you
↧
↧

Runtim 1004 - check for duplicate before entering

September 12, 2016, 7:46 pm
$
0
0
I'm using the code below to check worksheet name "LIST" in column A for the value in textbox tbaddpm.

if there is an exact match MsgBox "NAME ALREADY ENTERED"

otherwise add the value in textbox tbaddpm to the first blank cell.

I'm getting a runtime error 1004 here:

Code:
Set JobNum = ws.Range("A1:A" & LRow).Find(What:=Me.tbaddpm, SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues)
Any ideas? I can post a sample if needed...usually my mistakes seem to be easy to spot (for everyone else but me of course). Thanks for the help!


Code:
Private Sub cmbAddPM_Click()

Set ws = Sheets("LIST")

    If Trim(Me.tbaddpm.Value) = "" Then
        Me.tbaddpm.SetFocus
        MsgBox "ENTER A NAME"
    Else
End If

   
Dim JobNum As Range
Set JobNum = ws.Range("A1:A" & LRow).Find(What:=Me.tbaddpm, SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues)

If JobNum Is Nothing Then

Else
    MsgBox "NAME ALREADY ENTERED"
   
End If
       
        With Worksheets("LIST")
            .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = Me.tbaddpm.Value
        End With

 

    Me.tbaddpm.Value = ""

End Sub
↧

VB Excel, Count shapes with same color

September 12, 2016, 8:15 pm
$
0
0
Hi,
I'm new with VB. Pls bare with me.
I using VB excel and trying to get the number of shapes with same color but I'm stuck.
I had assigned a macro to insert shape with fixed color selection (where there will be more than 100+ of shapes with some fixed colors in my excel sheet),
and I need to get the summary of total of shapes with same color. For example,

I have 3 red shapes, 3 green shapes and 2 yellow shapes, I wish to get the result as
Cell (2,1): 3 (Red)
Cell (3,1): 3 (Green)
Cell (4,1): 2 (Yellow)

'Code to get the shape
Private Sub Green_Click()

Set myDocument = Worksheets(1)
myDocument.Shapes.AddShape(msoShapeRectangle, _
90, 90, 90, 50).Select
With Selection.ShapeRange.Fill
.ForeColor.RGB = RGB(0, 300, 0)
.BackColor.RGB = RGB(0, 300, 0)
.TwoColorGradient msoGradientHorizontal, 1
End With
With Selection.ShapeRange.Line
.ForeColor.RGB = RGB(0, 300, 0)
.BackColor.RGB = RGB(0, 300, 0)
End With

With SelectShapeColor
Unload Me
End With

End Sub


'Code for Calc Number of Shape
Sub CalcShape()

Dim sh As Sheet1
Dim shp As Shape
Dim a As Long
Dim b As Long
Dim CountShape As Long

For Each shp In Sheet1.Shapes
CountShape = 0
If shp.Fill.ForeColor.RGB = RGB(0, 300, 0) Then
Sheet1.Cells(2, 1) = CountShape + 1
End If
Next shp

End Sub

There is no error shows and the result I got is "1"
I'm not sure where goes wrong.
Pls helps~
Thanks
↧

Label Caption return blank value if cell is blank

September 12, 2016, 9:30 pm
$
0
0
Hi there,

I have a VBA UserForm which returns the values of particular cells in a sheet. These cells will update quite often and sometimes there will be no value returned, so the cell remains blank but when I open the UserForm, the label linked to the cell will show "0" instead of returning blank.

Below is the code I am using:
Code:
Private Sub CommandButton1_Click()
    Label10.Caption = Sheet1.Range("AA8")
End Sub
Is there something basic I could add in there for if the cell returns "0"/blank that the label also returns blank.

Thanks
↧
↧

Why do my COUNTIFS calculate incorrectly ?

September 12, 2016, 10:24 pm
$
0
0
Hello To All And I Thank Anybody Who Reads My Debacle,

Can anybody help with this ? The count is incorrect and I do not know why, a sample file is attached.

[code]

Sub Bin()

'Dim ws As Worksheet
Dim Number_2 As Single
Dim Answer As Single
Dim Answer_2 As Single
Dim Last_row As Double
Dim Last_bin As Double
Dim plus As Range
Dim minus As Range
Dim ans As Double
Dim i As Integer


'Number_1 = Range("D4").Value
Number_2 = 20 '"Range" number as stated in cell C4 is then divided by any integer. i.e. 5,10,20 etc..

Application.ScreenUpdating = False

For Each ws In Sheets
ws.Activate
Range("D4").Formula = "=D2-D3"
Answer = Range("D4").Value / Number_2
Range("D5").Value = Answer
Range("C9").Formula = "=(C8 + $D$5)"
'Range("C9 + Number_2").FillDown
Range("C9:C28").FillDown

Last_row = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Last_bin = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row

Set plus = Range("A2:A" & Last_row)
Set minus = Range("B2:B" & Last_row)

Range("D8").Select
For i = 1 To Last_bin - 7

ans = Application.WorksheetFunction.CountIfs(minus, ">" & ActiveCell.Offset(0, -1), minus, "<" & ActiveCell.Offset(1, -1)) + Application.WorksheetFunction.CountIfs(plus, ">" & ActiveCell.Offset(0, -1), plus, "<" & ActiveCell.Offset(1, -1))
ActiveCell.Value = ans
ActiveCell.Offset(1, 0).Select
Next



Next ws

Application.ScreenUpdating = True

End Sub

[\code]




Aloha !
For some reason I cannot get the file to upload so here is an example below.




PLUS MINUS
A2 B2
16.47 -0.67
16.01 -1.38
14.25 0
14 -5.26
13.44 0
13.4 -9.71
11.7 -4.47
11.33 -0.12
11.07 0
10.97 -2.53
10.9 -0.68
10.6 -0.13
9.92 -2.61
9.67 0
9.65 -0.66
9.51 -0.09
9.24 -0.22
9.16 0
8.93 -0.26
8.84 -1.19
8.82 -2.35
8.74 -0.1
8.63 -3.55
8.54 -1.04
8.52 -2.13
8.5 -1.25
8.44 0
8.41 -0.53
8.34 -8.92
8.33 -0.87
8.27 -0.77
8.26 -1.54
8.22 -1.28
8.13 -0.22
8.11 -2.36
8.05 -0.31
7.92 -0.75
7.84 -1.73
7.76 -3.35
7.76 -0.25
7.74 -0.76
7.72 -0.45
7.72 0
7.68 -1.95
7.62 0
7.5 -0.09
7.48 -0.79
7.47 0
7.43 -1.03
7.3 0
7.29 -1.21
7.29 0
7.28 -2.46
7.25 0
7.22 -2.97
7.16 0
7.08 -0.38
7.06 -0.18
7.04 -3.14
6.92 -4.19
6.86 -0.11
6.71 0
6.68 -0.15
6.61 0
6.57 0
6.54 -3
6.45 -0.29
6.45 -0.16
6.43 -4.62
6.42 -0.12
6.38 -0.38
6.36 -0.23
6.32 -5.11
6.32 0
6.31 -0.98
6.31 0
6.3 -0.88
6.3 -0.44
6.26 -0.57
6.24 0
6.19 -0.24
6.17 -1.28
6.17 -0.76
6.17 0
6.11 -0.41
6.1 -0.94
6.08 -0.9
6.05 -0.48
6.04 -0.09
6.01 -0.55
5.97 -1.42
5.95 0
5.92 -1.56
5.92 -0.89
5.92 -0.49
5.88 -1.26
5.87 -0.88
5.86 -1.34
5.86 -0.79
5.85 -0.15
5.81 0
5.77 -0.58
5.76 0
5.75 -0.19
5.75 0
5.74 -1.75
5.74 -0.08
5.74 0
5.73 -1.48
5.73 -1.02
5.7 -0.19
5.7 0
5.65 -2.95
5.65 -1.03
5.6 -9.63
5.59 -0.77
5.56 -0.14
5.56 -0.13
5.56 0
5.55 -0.07
5.53 -3.05
5.52 -0.88
5.51 -0.84
5.5 -1.81
5.5 -1.57
5.49 -3.16
5.49 -0.15
5.46 -2.16
5.46 -1.02
5.45 -0.35
5.44 -1.36
5.44 0
5.42 -0.39
5.42 -0.29
5.41 -2.76
5.39 -0.3
5.38 -1.52
5.36 -1.93
5.36 -1.29
5.36 -0.21
5.33 -2.12
5.33 -1.11
5.32 -0.26
5.31 -20.45
5.3 0
5.29 -1.06
5.29 0
5.27 -3.42
5.26 0
5.24 -0.36
5.24 0
5.2 -0.69
5.2 0
5.19 0
5.17 -3.28
5.16 -1.81
5.16 -0.65
5.15 -0.32
5.14 -0.83
5.13 -0.09
5.11 -0.27
5.07 -0.52
5.05 -2
5.05 -1.65
5.04 -1.37
5.01 -0.73
5 -0.16
4.98 -0.35
4.98 -0.33
4.98 0
4.97 -0.1
4.95 0
4.94 -0.62
4.93 -0.64
4.92 -0.44
4.91 -0.19
4.91 0
4.9 -2.09
4.89 -1.66
4.87 -0.56
4.86 -1.05
4.85 -3.67
4.85 -1.29
4.82 -0.69
4.82 -0.5
4.79 -0.96
4.77 -1.32
4.77 -0.78
4.77 0
4.76 0
4.74 -1.12
4.71 -3.84
4.71 -1.49
4.7 -0.6
4.69 -1.84
4.69 -1.77
4.68 -1.53
4.68 0
4.66 0
4.66 0
4.65 0
4.64 -3.84
4.63 -1.07
4.63 0
4.62 -4.36
4.61 -5.68
4.61 0
4.6 -1.25
4.6 -0.31
4.6 -0.23
4.6 -0.08
4.59 -0.12
4.58 -0.55
4.58 0
4.57 -3.24
4.57 0
4.56 -1.23
4.56 -0.11
4.55 -0.41
4.53 0
4.52 -0.77
4.52 -0.49
4.51 -0.41
4.5 -0.36
4.5 -0.28
4.5 -0.08
4.5 -0.08
4.5 0
4.49 -1.77
4.49 -1.08
4.49 -0.24
4.47 -2.64
4.47 -1.72
4.46 -1.88
4.46 -0.14
4.46 0
4.45 -0.57
4.44 0
4.44 0
4.42 -3.19
4.42 -0.22
4.41 -0.5
4.41 -0.4
4.4 -0.23
4.39 -0.34
4.39 -0.13
4.39 0
4.38 -0.94
4.38 0
4.37 -0.97
4.37 0
4.35 -1.86
4.35 -0.62
4.35 0
4.35 0
4.34 -0.46
4.31 -0.62
4.31 0
4.31 0
4.31 0
4.3 -0.03
4.3 0
4.28 -0.6
4.27 -1.06
4.27 -0.37
4.27 -0.26
4.26 -0.12
4.26 0
4.25 -0.66
4.25 -0.09
4.24 -0.52
4.24 0
4.24 0
4.24 0
4.23 -1.54
4.21 -4.43
4.21 -1.74
4.21 0
4.21 0
4.2 -0.41
4.2 -0.39
4.2 -0.15
4.2 0
4.19 -0.23
4.17 -0.6
4.17 0
4.16 -0.32
4.15 -2.8
4.14 -4
4.14 -0.53
4.14 -0.53
4.14 -0.16
4.13 -1.54
4.13 -0.69
4.13 -0.11
4.13 0
4.12 -0.43
4.12 -0.3
4.12 -0.21
4.1 -2.27
4.1 0
4.09 -1
4.08 -0.91
4.07 -2.07
4.07 -0.41
4.07 -0.13
4.06 0
4.05 -2.45
4.05 0
4.04 -1.01
4.04 -0.55
4.03 -1.2
4.03 -0.99
4.03 -0.67
4.03 -0.29
4.03 -0.17
4.02 -2.22
4.02 -0.98
4.02 -0.57
4.01 -2.77
4.01 -0.18
4 -1.2
3.99 -3.74
3.99 -0.27
3.99 -0.19
3.99 0
3.99 0
3.98 -1.79
3.98 -0.4
3.97 -0.71
3.97 -0.55
3.95 -3.39
3.95 -0.56
3.94 -1.49
3.93 -1.59
3.93 -0.39
3.92 0
3.92 0
3.91 -1.65
3.91 0
3.9 0
3.89 -1.4
3.89 -1.06
3.89 -0.58
3.89 -0.37
3.89 0
3.88 -2.91
3.88 -0.33
3.88 -0.18
3.88 -0.13
3.87 -0.63
3.87 0
3.87 0
3.86 -1.42
3.86 -0.71
3.86 -0.21
3.86 0
3.86 0
3.85 -4.13
3.85 -0.44
3.85 -0.29
3.85 0
3.84 -0.26
3.83 -2.01
3.83 0
3.83 0
3.81 0
3.79 -0.97
3.79 0
3.79 0
3.78 -4.44
3.78 -0.18
3.78 -0.16
3.77 -1.15
3.77 -0.56
3.77 0
3.76 -0.24
3.76 -0.1
3.75 -0.17
3.75 0
3.75 0
3.74 -1.15
3.74 -0.85
3.74 -0.53
3.73 -1.49
3.73 0
3.72 -1.12
3.72 -0.74
3.72 -0.53
3.72 -0.15
3.71 -0.47
3.7 -0.27
3.69 -0.56
3.69 0
3.69 0
3.68 -0.68
3.68 -0.24
3.68 -0.1
3.68 0
3.66 -0.26
3.66 -0.13
3.66 0
3.65 -0.85
3.65 0
3.65 0
3.64 -0.22
3.63 0
3.62 -3.15
3.62 -0.27
3.62 -0.19
3.62 0
3.61 -0.71
3.61 0
3.61 0
3.6 -1.2
3.6 -0.5
3.59 -0.61
3.59 -0.08
3.58 -2.6
3.57 -2.31
3.57 -0.61
3.57 0
3.57 0
3.57 0
3.56 -1.01
3.56 -0.99
3.56 -0.63
3.56 0
3.55 -1.18
3.55 -1.03
3.55 -0.31
3.55 -0.17
3.53 -0.21
3.52 -0.2
3.52 0
3.51 -0.14
3.5 -1.51
3.5 -0.4
3.5 0
3.49 -1.75
3.49 -0.92
3.49 -0.53
3.49 0
3.48 -1.19
3.48 0
3.47 -0.11
3.46 -2.55
3.46 -1.22
3.46 -0.18
3.46 0
3.45 -1.6
3.45 -0.17
3.45 -0.11
3.44 -4.75
3.44 -1.15
3.44 -0.86
3.44 -0.2
3.43 0
3.42 -1.85
3.41 -0.52
3.41 -0.37
3.41 -0.21
3.4 -0.29
3.4 -0.25
3.4 -0.06
3.39 0
3.38 -3.47
3.38 -0.53
3.38 -0.32
3.37 -1.1
3.37 -0.37
3.36 -1.29
3.36 -1.12
3.36 -1.05
3.36 -0.62
3.36 -0.32
3.35 -0.18
3.35 0
3.34 -2.15
3.34 -0.14
3.34 0
3.33 -0.78
3.32 -2.26
3.32 -0.5
3.32 -0.22
3.32 0
3.32 0
3.31 -5.4
3.31 -1.43
3.31 -0.33
3.31 -0.26
3.31 -0.13
3.31 0
3.3 -0.38
3.3 -0.1
3.3 0
3.3 0
3.29 -1
3.29 -0.62
3.29 -0.58
3.29 -0.03
3.28 -2.48
3.28 -1.53
3.28 -0.48
3.28 -0.2
3.28 0
3.28 0
3.27 -11.67
3.27 -0.4
3.27 -0.16
3.27 -0.14
3.26 -2.91
3.26 -2.15
3.26 -0.31
3.26 0
3.26 0
3.25 -5.88
3.25 0
3.24 -2.16
3.24 -1.22
3.24 -0.22
3.24 0
3.24 0
3.23 -1.61
3.23 -0.38
3.22 -0.99
3.22 -0.27
3.22 0
3.22 0
3.21 -0.13
3.21 0
3.21 0
3.2 -0.36
3.2 0
3.19 -2.45
3.19 -0.77
3.19 0
3.18 -0.65
3.18 -0.61
3.18 0
3.17 -0.86
3.17 -0.19
3.17 -0.12
3.17 0
3.17 0
3.16 -0.97
3.16 -0.24
3.15 -0.85
3.15 -0.37
3.15 -0.12
3.15 -0.09
3.15 0
3.14 -1.76
3.14 0
3.13 -1.05
3.13 -0.42
3.13 -0.42
3.13 -0.24
3.13 -0.12
3.13 0
3.12 -1.98
3.12 0
3.11 -2.68
3.11 -2.07
3.1 -2.52
3.1 -0.49
3.1 -0.37
3.1 -0.3
3.1 0
3.09 -3.09
3.09 -1.35
3.09 -0.77
3.09 -0.58
3.09 -0.53
3.09 -0.14
3.09 0
3.09 0
3.08 -1.73
3.08 -1.22
3.08 -0.77
3.08 -0.68
3.08 -0.62
3.07 -0.63
3.07 -0.33
3.07 -0.13
3.07 0
3.06 -0.52
3.06 -0.08
3.06 0
3.05 -1.08
3.05 -0.7
3.05 -0.64
3.05 -0.49
3.05 -0.34
3.05 0
3.03 -5.44
3.03 -1.63
3.03 -1.12
3.03 -0.39
3.03 0
3.02 -1.31
3.02 -0.3
3.02 0
3.02 0
3.02 0
3.01 -5.29
3.01 -1.86
3.01 -1.23
3.01 -0.82
3.01 0
3 -1.1
3 -0.75
3 0
3 0
3 0
2.99 -5.58
2.99 -0.54
2.99 -0.14
2.98 -1.81
2.98 -0.53
2.97 -1.98
2.97 -1.68
2.97 -0.68
2.97 -0.68
2.97 0
2.97 0
2.97 0
2.97 0
2.96 -0.51
2.96 -0.08
2.96 0
2.95 -2.16
2.95 -1.64
2.95 -0.44
2.95 -0.4
2.95 -0.32
2.95 0
2.95 0
2.95 0
2.94 -0.74
2.94 -0.09
2.93 -3.93
2.93 -1.13
2.93 -0.73
2.93 -0.44
2.93 -0.24
2.93 0
2.92 -2.83
2.92 -1.4
2.92 -0.47
2.91 -0.5
2.91 0
2.9 -1.41
2.9 -1.2
2.9 0
2.9 0
2.89 -1.77
2.89 -0.91
2.89 -0.54
2.89 -0.09
2.89 0
2.88 -1.44
2.88 -1.24
2.88 -1.2
2.88 -0.66
2.88 -0.65
2.88 -0.47
2.88 -0.39
2.88 -0.15
2.88 -0.09
2.88 -0.02
2.88 0
2.87 -2.65
2.87 -0.1
2.87 -0.08
2.87 -0.07
2.87 0
2.86 -4.33
2.86 -0.36
2.86 -0.03
2.86 0
2.86 0
2.85 -1.98
2.85 -0.2
2.85 -0.14
2.85 0
2.85 0
2.84 -1.27
2.84 -0.57
2.84 -0.51
2.84 -0.41
2.83 -0.71
2.83 -0.22
2.83 -0.07
2.83 0
2.82 -1.86
2.82 -0.81
2.82 -0.68
2.82 -0.19
2.82 -0.18
2.82 0
2.82 0
2.81 -0.89
2.81 -0.78
2.81 -0.7
2.81 -0.37
2.81 0
2.81 0
2.8 -0.96
2.8 -0.85
2.8 -0.74
2.8 -0.54
2.8 -0.32
2.8 -0.1
2.79 -1.01
2.79 -0.8
2.79 -0.73
2.79 -0.33
2.78 -2.55
2.77 -1.89
2.77 -1.22
2.77 -1.14
2.77 -1.09
2.77 -0.72
2.77 -0.7
2.77 -0.63
2.77 -0.23
2.77 0
2.77 0
2.76 -1.73
2.76 -0.99
2.76 -0.44
2.76 -0.38
2.76 -0.24
2.76 -0.24
2.76 0
2.75 -4.44
2.75 -1.6
2.75 -1.2
2.75 -0.89
2.75 -0.85
2.75 -0.84
2.75 -0.07
2.74 -2.11
2.74 -0.76
2.74 -0.69
2.74 -0.27
2.74 -0.03
2.73 -5.78
2.73 -5.09
2.73 -0.8
2.73 -0.46
2.73 -0.33
2.73 -0.29
2.73 -0.14
2.73 0
2.72 -1.18
2.72 -0.89
2.72 -0.84
2.72 -0.68
2.72 -0.62
2.72 -0.08
2.71 -1.18
2.71 -0.18
2.71 0
2.71 0
2.7 -0.41
2.7 -0.02
2.7 0
2.7 0
2.69 -2.2
2.69 -1.22
2.69 -1.07
2.69 -1.06
2.69 -0.07
2.68 -2.68
2.68 -0.74
2.68 -0.61
2.68 -0.51
2.68 -0.38
2.68 -0.14
2.68 0
2.67 -6.15
2.67 -3.9
2.67 -1.71
2.67 -1.31
2.67 -1.22
2.67 -0.34
2.67 0
2.66 -9.43
2.66 -3.87
2.66 -1.9
2.66 -0.96
2.66 -0.22
2.66 -0.2
2.66 -0.15
2.66 0
2.66 0
2.65 -0.76
2.65 -0.14
2.65 -0.08
2.65 0
2.65 0
2.64 -4.59
2.64 -3.47
2.64 -1.4
2.64 -1.32
2.64 -1
2.64 -0.5
2.64 -0.22
2.64 -0.16
2.64 -0.08
2.64 0
2.63 -4.16
2.63 -2.83
2.63 -2.06
2.63 0
2.63 0
2.63 0
2.62 -2.93
2.62 -1.21
2.62 -1.03
2.62 -0.95
2.62 -0.77
2.62 -0.09
2.62 0
2.62 0
2.62 0
2.61 -1
2.61 -0.34
2.61 -0.32
2.61 -0.24
2.61 -0.13
2.61 -0.13
2.61 -0.12
2.6 -0.84
2.6 -0.73
2.6 -0.55
2.6 0
2.6 0
2.59 -8.13
2.59 -1.69
2.59 -1.29
2.59 -0.4
2.59 -0.38
2.59 0
2.59 0
2.58 -3.4
2.58 -2.78
2.58 -1.44
2.58 -0.71
2.58 -0.15
2.58 0
2.57 -0.71
2.57 -0.17
2.57 0
2.57 0
2.57 0
2.56 -0.82
2.56 -0.65
2.56 -0.29
2.56 -0.27
2.56 0
2.55 -0.95
2.55 -0.49
2.55 -0.43
2.55 -0.39
2.55 -0.23
2.54 -0.39
2.53 -1.65
2.53 -1.55
2.53 -1.41
2.53 -1.31
2.53 -0.87
2.53 -0.55
2.53 -0.41
2.52 -0.56
2.52 -0.55
2.52 -0.23
2.52 -0.09
2.51 -1.04
2.51 -0.75
2.51 0
2.51 0
2.5 -6
2.5 -4.8
2.5 -2.89
2.5 -2.46
2.5 -2.31
2.5 -1.07
2.5 -1.03
2.5 -0.5
2.5 -0.44
2.5 -0.39
2.5 -0.3
2.5 0
2.49 -1.45
2.49 -0.79
2.49 -0.7
2.49 0
2.48 -4.4
2.48 -3.25
2.48 -2.96
2.48 -0.93
2.48 -0.35
2.48 -0.22
2.48 0
↧

[SOLVED] DateSerial and Invalid Dates

September 12, 2016, 10:56 pm
$
0
0
Hello all,

For some reason dateserial returns the next valid date when a invalid date is encountered.
Is there a way to overcome this.
I'd like to return a message when an invalid date is found

Code:
Sub TEST()
    Vday = Sheets("Sheet1").Range("E7").Value
    Vmonth = Sheets("Sheet1").Range("E6").Value
    Vyear = Sheets("Sheet1").Range("E5").Value
    VdATE = DateSerial(Vyear, Vmonth, Vday)
   
    If Not IsDate(VdATE) Then
    Sheets("Sheet1").Range("E9").Value = "invalid"
    Else
    Sheets("Sheet1").Range("E9").Value = VdATE
    End If
End Sub
Any ideas?
↧

Check is pivot table filtered

September 12, 2016, 11:05 pm
$
0
0
Hi,

For clearing all filters in my pivot table I use code:

PivotTables("my_pivot").ClearAllFilters

but how can I check if any filter in my pivot table is on?
↧
Search

calculate salary problem

September 13, 2016, 12:39 am
$
0
0
Code:
Private Sub CommandButton2_Click()

Dim i As Integer
Dim totalpay As Double


'Calculate D.A & H.R.A
LastRow = Sheets("Earnings").Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To LastRow
    cells(i, 8) = Round((cells(i, 7) * cells(4, 22)), 0)
    cells(i, 9) = Round((cells(i, 7) * cells(5, 22)), 0)

'calulate T.A
EndRow = Sheets("Employee").Range("A" & Rows.Count).End(xlUp).Row
For j = 2 To EndRow
Select Case Sheets("Employee").cells(j, 8)
Case 1800 To 1900
Sheets("Earnings").cells(i, 10) = 900 + Round(900 * cells(4, 22), 0)
Case 2000 To 4800
Sheets("Earnings").cells(i, 10) = 1800 + Round(1800 * cells(4, 22), 0)
Case Is >= 5400
Sheets("Earnings").cells(i, 10) = 3600 + Round(3600 * cells(4, 22), 0)
Next j

totalpay = (cells(i, 7) + cells(i, 8) + cells(i, 9) + cells(i, 10) + cells(i, 11) + cells(i, 12) + cells(i, 13) + cells(i, 14) + cells(i, 15))

cells(i, 16) = totalpay

Next i
MsgBox ("Salary Calculate  Successfully")

End Sub


Using above code I would calculate salary for all the employee in sheet (“Earnings”). But when I execute the code it’s not work .I think the problem for calculate T.A only. The procedure for calculation of T.A is follows:

First check column 8 of Employee sheet( i.e Grade Pay) , if grade Pay is 1800 to 1900 then
Sheets("Earnings").cells(i, 10) = 900 + Round(900 * cells(4, 22), 0).
If grade pay 2000 to 4800 then
Sheets("Earnings").cells(i, 10) = 1800 + Round(1800 * cells(4, 22), 0)
If grade pay >= 5400 then
Sheets("Earnings").cells(i, 10) = 3600 + Round(3600 * cells(4, 22), 0)

Kindly help in this task.
Attached Files
↧
↧

[SOLVED] Macro to split a string into 2 texts based on where is the capital letter

September 13, 2016, 12:43 am
$
0
0
Hi guys,

I have an odd export and i have normal names and combined names. When i say normal I say e.g Ionut etc.
The odd format comes from the export and it seems that some names have the format like JohnMonet.

I would like to ask for help from you guys, in order to run a macro that will split these formats into John and Monet. I can insert a new column --E and in that E i want to have the Monet and the rest to stay in col. D.

The macro should run only when it will see that inside of a word is another capital letter and will take the rest of the word starting from the capital letter to the rest of the word and will paste it in D.

Thank you,
Ionut
↧

[SOLVED] Code failling to clear checkboxes

September 13, 2016, 12:45 am
$
0
0
I appear to have missed something: the code falls over on the line .CheckBoxes.Value=False with the error message 1004 - Unable to set the Value property of the Checkboxes class. The code should untick all the Check Boxes in the sheet before the If range values resets them. There are around 50 Check Boxes that need to be unticked and then reset. Part of the code reads:

Code:
Application.Sheets("Admission Data Entry").Select
    With ActiveSheet
        .CheckBoxes.Value = False
        If .Range("af11").Value = True Then
        .CheckBoxes("Check Box 167").Value = True
        End If
        If .Range("ag11").Value = True Then
        .CheckBoxes("Check Box 286").Value = True
        End If
Any help appreciated
↧

Get excel to automatically scroll to the current date

September 13, 2016, 1:50 am
$
0
0
Hello,

i am making a vacation spreadsheet for my work, and Need a macro that will scroll directly to the current date when the sheet is opened.
I am not allowed to share the content, so i can't share a screenshot or anything.

The dates are in row 5, and on worksheet 1 (called 2016) are the dates from September to december 2016.
On worksheet 2(called 2017) are the dates from january to december 2017.

So what i exactly Need is a macro that will:

Scroll automatically to the current date - and activate that cell
The macro must search all worksheets - and go to the worksheet where the current date is placed.

I hope someone can help me, since i am really not that good with creating macros.

Best Regards
Nanna
↧

Adding msg box

September 13, 2016, 2:21 am
$
0
0
Hello all, I have this macro figured out from this site many thanks:

Sub CheckIfCellIsEmpty()
Dim isMyCellEmpty As Boolean
isMyCellEmpty = IsEmpty(Range("D48"))

If isMyCellEmpty = True Then
MsgBox "Intelligence Report Requires Completing & the Box Selected"
End If
End Sub

Is it possable to add a second cell (D49) with a msg "CR not Complete", I would like the macro to check each cell in turn to remind the user to complete these tasks. Each with the allocated msg.

Also would the user then need re-run the macro, or would it continue once cells are complete, re-run would be the prefered option.

Many thanks
↧
↧

Can't lock aspect ratios of inserted pictures?

September 13, 2016, 2:59 am
$
0
0
Hi guys I need your help once again!

I have the following code:

Code:
With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .ButtonName = "Insert"
        .title = "Select an image file"
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "Tag Image File Format", "*.TIFF"
        .Filters.Add "All Pictures", "*.*"

        If .Show = -1 Then
            Dim img As Object
            Set img = Sheets("Pictures").Pictures.Insert(.SelectedItems(1))

            'Position Image
            img.Left = Sheets("Pictures").Cells(picrow, piccolumn).Left
            img.Top = Sheets("Pictures").Cells(picrow, piccolumn).Top
           

            'Set image sizes in points (72 point per inch)
            img.LockAspectRatio = msoFalse
            img.Width = 227
            img.Height = 170
           
        Else
            MsgBox ("Cancelled.")
        End If
    End With
But I get a "runtime error 438 object doesn't support this method or property" at the line where the aspect ratio is locked?

I really can't understand it because I think that my syntax is correct? All help would be greatly appreciated!

Thanks

Tom
↧

[SOLVED] Error handling

September 13, 2016, 3:02 am
$
0
0
I need to abort a macro if certain conditions are not met when the macro is run. The code so far is:


Code:
Sub Recall()
'
' Recall Macro
'

'
    Application.ScreenUpdating = False
    Range("AC11").Select
    Selection.Copy
    Range("E12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AD11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("E13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AE11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("E14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
However, if any cell in the range E9:E11 is blank the macro should return a message box with 'ensure data is...etc." and then abort when the user hits OK. So it's an If or(isblank(E9),isblank(e10),Isblank(E11)) if I was writing a formula but I can't figure it for VBA.

Any help appreciated.
↧
Search

Simple loop

September 13, 2016, 3:31 am
$
0
0
I would like to create simple loop.
I want adding cells under active cell until sum is more than number in start cell.
Then I want to get number, how many cells were add, for example three cells on right from active cell.
Can you help me?
↧

If Macro Fails End Sub

September 14, 2016, 1:56 am
$
0
0
Hi all,

I would like a macro that ends automatically if it fails.

When the spreadsheet is opened if an error is shown I would like it to end and not debug or anything else, is this possible?

I need this as anyone else who opens my spreadsheet doesn't need to see or run the macro - If they click enable Macros on that sheet it will run automatically.

Any help would be awesome - Thanks in advance.

Frank.
↧
↧

How to resolve the Run-time error 1004

September 14, 2016, 1:56 am
$
0
0
Private Sub cmdvSOM_Click()
Dim wb As Workbook
Dim wsvSOM As Worksheet
Dim wsReport As Worksheet

Set wb = ActiveWorkbook
Set wsvSOM = Sheets("Master Data_vSOM")
Set wsReport = Sheets("Report")


If Me.cboPartnervSOM.Value = "" Then

MsgBox ("Select the Partner")

Else

wsReport.Range("A13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 1, False)
wsReport.Range("B13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 2, False)
wsReport.Range("C13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 3, False)
wsReport.Range("D13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 4, False)
wsReport.Range("E13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 5, False)
wsReport.Range("F13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 6, False)
wsReport.Range("G13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 7, False)
wsReport.Range("H13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 8, False)
wsReport.Range("I13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 9, False)
wsReport.Range("J13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 10, False)
wsReport.Range("K13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 11, False)
wsReport.Range("L13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 12, False)
wsReport.Range("M13") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("A2").CurrentRegion, 13, False)



wsReport.Range("A19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 1, False)
wsReport.Range("B19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 2, False)
wsReport.Range("C19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 3, False)
wsReport.Range("D19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 4, False)
wsReport.Range("E19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 5, False)
wsReport.Range("F19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 6, False)
wsReport.Range("G19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 7, False)
wsReport.Range("H19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 8, False)
wsReport.Range("I19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 9, False)
wsReport.Range("J19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 10, False)
wsReport.Range("K19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 11, False)
wsReport.Range("L19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 12, False)
wsReport.Range("M19") = Application.WorksheetFunction.VLookup(Me.cboPartnervSOM.Value, wsvSOM.Range("P2").CurrentRegion, 13, False)



End If


Me.cboAirwatch.Value = ""
End Sub
↧

[SOLVED] Multiple Ranges Error

September 14, 2016, 2:02 am
$
0
0
Hello. I have been using the VBA code below to insert the date in the cell above the one where I insert some data. I am now trying to add another set of 12 ranges from the same sheet and I encounter an error. Apparently, there's a limit to the number of ranges to be added. The error says: " Runtime error 1004. Method 'Range' of Object_Worksheet' Failed " - Whatever that means. I was wondering if anyone could help me with a way around this error. Can I start a different "If" with the same code to insert the new ranges there? Or how can I solve this? Thanks a lot.
Note: I am terrible with VBA. :)

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("c4:g4,c6:g6,c8:g8,c10:g10,c12:g12,c14:g14,c16:g16,c18:g18,c20:g20,c22:g22,c24:g24,c26:g26,m4:q4,m6:q6,m8:q8,m10:q10,m12:q12,m14:q14,m16:q16,m18:q18,m20:q20,m22:q22,m24:q24,m26:q26")) Is Nothing Then
Cells(Target.Row - 1, Target.Column).Value = Format(Now(), "mmmm/dd")
End If
End Sub
↧

Transfer important data from a messy rawdata

September 14, 2016, 2:21 am
$
0
0
I have an unpredictable data, which I need a macro to be able to transfer the data. In the attached file, in the INPUT tab, all yellow should be transferred in a new sheet. Most of the data has dates/value on the column C. The highlights are for this sample purposes only and not in the actual.

Is there a macro on how I can transfer the line or the data to a new sheet with this data behavior?

Thanks.
Attached Files
↧
Viewing all 50057 articles
Browse latest View live
Search