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

VBA to open 2 JPEG files in MSPaint and copy File 1 and paste in File 2.

December 23, 2015, 1:01 pm
$
0
0
Hi,
I'm looking for help on how to accomplish these steps:

1) Open File 1 and File 2 using MSPaint.
2) Copy the File 1 image, and paste in to File 2.
3) Close File 1 without saving.
4) Activate the File 2 window.

I have step 1 covered, but am looking for help with steps 2-4.

Thanks in advance!

EDIT: Here is the code I have so far...

Code:
'OPEN FILE 1
        File1 = Range("PATH_INVOICE_SUBFOLDER").Value & "\" & Range("INVOICE_SNIP_FILE_NAME").Value & ".jpg"
        Shell Chr(34) & "mspaint.exe" & Chr(34) & " " & Chr(34) & File1 & Chr(34), 1

'OPEN FILE 2
        File2 = Range("PATH_INVOICE_SUBFOLDER").Value & "\" & Range("INVOICE_FILE_NAME").Value & ".jpg"
        Shell Chr(34) & "mspaint.exe" & Chr(34) & " " & Chr(34) & File2 & Chr(34), 1

'COPY FILE 1 AND PASTE IN FILE 2

'CLOSE FILE 1 WITHOUT SAVING

'ACTIVATE FILE 2 WINDOW
↧
Search

[SOLVED] What Wrong With my Code? compile information to worksheet

December 23, 2015, 2:09 pm
$
0
0
I've written the attached code and can't figure out what i'm doing wrong. I'm trying to copy, sort, and paste information from a bunch of sheets. The below code goes into a death spiral copying and pasting only from the first sheet in my workbook. What's wrong with my code? Why won't it continue through the loop?

Code:
Sub Compile()


    Dim sh As Worksheet
    Dim UKsh As Worksheet
    Dim EUsh As Worksheet
    Dim USsh As Worksheet
    Dim EUrow As Long, UKrow As Long, USrow As Long
    Dim x As Long, y As Long

    EUrow = 2
    UKrow = 2
    USrow = 2

Set UKsh = Sheets("UK")
Set EUsh = Sheets("EU")
Set USsh = Sheets("US")


For Each sh In Worksheets

        If Range("a60") = "EU" Then
            ActiveSheet.Range("C8:C48").Copy
            EUsh.Range("A" & EUrow).PasteSpecial Transpose:=True
            Application.CutCopyMode = False
            EUrow = EUrow + 1
        ElseIf Range("a60") = "UK" Then
            ActiveSheet.Range("C8:C48").Copy
            UKsh.Range("A" & UKrow).PasteSpecial Transpose:=True
            Application.CutCopyMode = False
            UKrow = UKrow + 1
        Else
            ActiveSheet.Range("C8:C48").Copy
            USsh.Range("A" & USrow).PasteSpecial Transpose:=True
            Application.CutCopyMode = False
            USrow = USrow + 1
        End If
   

Next
End Sub
↧
↧

[SOLVED] Macro not Finding "blank" visible cells (when filtering

December 23, 2015, 4:21 pm
$
0
0
Hello there - This is my first post ever so I hope I am posting in the correct area.

I have a macro which I am attempting to code to validate if filtered data is blank. So far, after many searches on the internet I've not turned up any code that can assist with this. The filtered data is formatted as "General" (ex of data "28 NDC").

When filtering, if there is no data present, I want the macro to validate that the next visible cell is empty/blank. So far no attempts to use Count, CountA or anything have allowed me to succesfully traverse the visible cells, identify if cell is blank or not.

If the data is not present, then the macro should use GoTo FDC: (next filtered value "26 FDC") and run the same validations. I have 23 "values" that this routine will have to run on, data will change in size from week to week, and total row count can exceed 500,000 lines, so I think that anything relying on "integer" is not sufficient.

Here is my code:

Code:
Sub test()

Dim iStatus As Long
Err.Clear

    'Find Audit Summary Tool (open file or activate workbook)
    On Error Resume Next
    Set WB = Workbooks("Audit Summary Tool.xlsm")
    iStatus = Err
    On Error GoTo 0
    'IF workbook isn't open
    If iStatus Then
      Workbooks.Open "I:\Inventory Control DC Support\Reference - Templates\DC Macros\CRYSTAL\Audit Summary Tool.xlsm"
    Else
    'IF work IS open
      WB.Activate
    End If
 
 On Error Resume Next
 
    Dim wbk As Workbook
    Set wbk = Workbooks("Audit Summary Tool.xlsm")
 
'NDC

wbk.Sheets("audits").Activate

AutoFilterMode = False

Range("A1").AutoFilter Field:=1, Criteria1:="28 NDC"
    If Range("A1").Offset(0, 1).SpecialCells(xlCellTypeVisible) = "" Then

GoTo FDC

  Else
   
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A:$AJ").AutoFilter Field:=1, Criteria1:="28 NDC"
    Range("AJ1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
   
    Application.Run ("Nova_Audit_Formatting")
 
   
   
  End If

'fdc

FDC:

wbk.Sheets("audits").Activate

AutoFilterMode = False

Range("A1").AutoFilter Field:=1, Criteria1:="26 FDC"
    If Range("A1").Offset(0, 1).SpecialCells(xlCellTypeVisible) = "" Then

GoTo SCD

  Else
   
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A:$AJ").AutoFilter Field:=1, Criteria1:="26 FDC"
    Range("AJ1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
   
    Application.Run ("Nova_Audit_Formatting")
 
   
   
  End If

...more code (looping above code starting at 'NDC' but changing filtered values for other locations
↧

Macro required to send Bday Wish with an attachment

December 23, 2015, 5:36 pm
$
0
0
hello,

I wand Macro code to send birthday wishes as email with an jpeg attachment (Desktop/BDAY CARD)

Mail should b send only once in a day even if the sheet is opened multiple times the same day

Subject Happy B'day "name"
Email Dear "name"
"Space"
Many Many Happy Returns of the day
"Space"
"Space"
Attach pic Desktop/BDAY CARD
"Space"
May God Bless U
"Space"
JK Ltd

Find attached sheet

Thanks
Jon
Attached Files
↧

Copy range to another sheet starting from where certain text ends

December 23, 2015, 6:18 pm
$
0
0
in the attached file I am trying to copy a range in the MONITOR file : A6 thru column F to last row

then copy/paste values this dynamic range to the DATA sheet starting from "K" column one row below the text : ACTUAL is reflected (which on column "J")

the ACTUAL is also dynamic; sometimes it can end in J30 and a week after ACTUAL can end in J200

So for example if ACTUAL is on J30 I want to copy the range from MONITOR sheet to be copied to DATA starting at K31
Attached Files
↧
↧

User Defined Formula not updating

December 23, 2015, 10:03 pm
$
0
0
Folks,
Hopefully some one can assist me. I have written a function to summarise some information from 1 sheet to another. On its own, it works a treat. The code is as follows.

Function SumByMonth(SheetName As String, TableRange As String, AcctMonth As Range) As Long
Dim SumRange As Range, Cell as range
Dim MonthRow As Integer, white As Integer
Dim Total As Long

Total = 0
MonthRow = 7 ' This is the row where month labels exist
white = 2

Set SumRange = Range(SheetName & "!" & TableRange)
For Each Cell In SumRange
If Worksheets(SheetName).Cells(MonthRow, Cell.Column) = AcctMonth Then
If Cell.Interior.ColorIndex > white Then
Total = Total + Cell.Value
End If
End If
Next Cell

SumByMonth = Total
End Function

I call this function from a Summary sheet in the following Manner
=SumByMonth("Actuals", "EF9:EO999",Summary!A25)

The problem is, I have another function in the background that updates the data yet these updates are not picked up by the above command on the summary TAB. To test further I added the following command below the =sumbymonth command to check the 2 cells being updated and it works every time:
=SUM(Actuals!EF30:EG30)

I don't want to make the code volatile as this would add to much to the response times. (The inbuilt sum command works a treat and I want my code to work the same way)
↧

Looping through array and comparing previous values

December 23, 2015, 10:07 pm
$
0
0
Hi, VBA beginner here. I've got a loop where I want to compare one value in an array to the one before it, and put data in a worksheet if they don't match. I do this by comparing value (k) to value (k - 1). I'm out of bounds in evaluating the first loop because k always is the first position in the array (1 in my case). I've come up with a workaround, as shown in the first two lines of my code, but it is unwieldy for other, more complicated loops. The example below is the simplest I could find that fully represents the problem.

So I'm wondering if there is a more elegant way to do this. The array is ~800 strings long and the macro will be run infrequently, so performance isn't a big issue. Thanks

Code:
    Range("B5").Offset(1) = MyArray(1, 2)
    j = 2

    For k = 2 To MyArrayCount
        If MyArray(k, 4) <> MyArray(k - 1, 4) Then
            Range("B5").Offset(j) = MyArray(k, 2)
        j = j + 1
        End If
    Next k
↧

[CONTRIBUTION] Simon says, Game

December 23, 2015, 10:27 pm
$
0
0
Hello I wanted to share this last game I've performed classic "Simon Says" I'm interested in all sorts of criticism to improve or learn. as clarified in the download link is only compatible with 2007, I ignore the later version in the statements of the APIs.

Download


SIMON1.png
SIMON2.png
↧
Search

vba to count cells

December 23, 2015, 10:33 pm
$
0
0
need vba for following task.

I have family id in column "E"
In column "J" I have details of their family members
I want to count of total family member including proposer against each proposer in column K
desired result mentioned on column k

Also please provide if any simple formula is available.
Attached Files
↧
↧

Summary Details

December 23, 2015, 10:48 pm
$
0
0
Hello everyone
I have data in sheet "Detail" with Table in column Q to AD and values in column S

First I need to do summary the data in sheet"DETAIL" to sheet "SUM"

Currently i have to do manual by copy data and past value to sheet"SUM" then remove duplicate value
and i have to do manual to sum of amount also

that is why need to use VBA to do all of theses this at one time

Thanks advanced for help
Attached Files
↧

Counting the colored cells

December 23, 2015, 11:02 pm
$
0
0
So I have been searching posts and reading about a few versions of VBA code used to count cells based on their color. Every version I have used gives me a #NAME error on the =CountColor(range,color) formula used in the cell returning the sum. I'm not sure if it is being caused by the data entered in the cells because when I define the range to count it shows all of those values in the formula assistant window. To be completely honest, my brain is "vapor locked" at this moment and I would like someone to show it to me on this spreadsheet I am working on for a friend. I can learn once I see what works and compare it to how I got it wrong. Is anyone willing to assist? The count should happen per row and I have put the desired result in the column on the right of the spreadsheet. The punchline here is she is looking to count the number of yellow cells per row.
Attached Files
↧

Finding Special Characters

December 24, 2015, 9:08 am
$
0
0
Hi All,

I want to find the special characters from the email. For example I have an email address in column. Here I want to find the special characters in the cell

abhina$vchava1

abhinavkan^dikattu2


Thanks
↧

Conditioned printing macro issue

December 24, 2015, 11:56 am
$
0
0
Hey Brand new to excel but I have been using it in the workplace and find my self to be learning fast.

I need a conditioned printing macro to print certain sheets and not others based on a value of a cell per sheet

here is the macro i am using which makes the "control sheet"
Sub CreateControlSheet()
Dim i As Integer

On Error Resume Next 'Delete this sheet if it already exists
Sheets("Control Sheet").Delete
On Error GoTo 0

Sheets.Add 'Add the WhatToPrint Sheet
ActiveSheet.Name = "Control Sheet"

Range("A1").Select 'Label the columns
ActiveCell.FormulaR1C1 = "Sheet Name"

Range("B1").Select
ActiveCell.FormulaR1C1 = "Print?"

Cells.Select
Selection.Columns.AutoFit

For i = 1 To ActiveWorkbook.Sheets.Count
Cells(i + 1, 1).Value = Sheets(i).Name
Next
End Sub



Now here is the other macro which reads this sheet and prints based on if there is ANY value in the B cells

Sub PrintSelectedSheets()
Dim i As Integer
i = 2

Do Until Sheets("Control Sheet").Cells(i, 1).Value = ""
If Trim(Sheets("Control Sheet").Cells(i, 2).Value <> "") Then
Sheets(Sheets("Control Sheet").Cells(i, 1).Value).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End If
i = i + 1
Loop
End Sub




My issue is that I would like it to print the sheets if the cell value reads "yes" or maybe if the value is greater than 0.
Ive tried =If but it still counts as filling in the cell.
↧
↧

Copy same range one below another until last active row

December 24, 2015, 12:00 pm
$
0
0
With the file attached I am trying to copy the a range in the MONITOR file: A6 thru column "F" to last row

then copy/paste values this dynamic range into the DATA sheet starting from "k" column , immediatly below the dynamic text: "ACTUAL" (on column "J")

The copy should be repeated (one below another) until the end of the active(dynamic) row in column "Q"
Attached Files
↧

Vba to move a row from one sheet to another in the same workbook

December 24, 2015, 12:13 pm
$
0
0
Hi All

I am trying to create a piece of VBA to move a row from one sheet to another when I enter a certain criteria. This is what I have but it is not working.

The button is CommandButton1 and I want it to carry out the action on click
The original sheet is called "Paperwork"
I want to move rows (on clicking on the button) from "Paperwork" to "Reviews" when I enter "completed" in any of the rows in column T. I want the row to be added to the first available row in the Reviews sheet.
I also want to delete the row from the original sheet once it has been moved.

I cant understand why it is not working. It is probably something simple but I thought I had better ask before I pull all of my hair out.

Here is my piece of code:

Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Integer
Sheets("Paperwork").Select
For i = 2 To Cells(Rows.Count, 20).End(xlUp).Row
If UCase(Cells(i, 20).Value) = "COMPLETED" Then
Rows(i).EntireRow.Copy Sheets("Reviews").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next
For j = Cells(Rows.Count, 20).End(xlUp).Row To 2 Step -1
If UCase(Cells(j, 20).Value) = "COMPLETED" Then
Rows(j).EntireRow.Delete
End If
Next
End Sub

In addition, I have saved the spreadsheet as *.xlsm, don't know if that matters or not?

Any help would be appreciated.

Teuchter
↧
Search

Highlight Duplicates

December 24, 2015, 12:25 pm
$
0
0
Hi Experts,

I am trying to copy a code for highlighting duplicate rows. For some reason, I am getting an Error "Object Required". Can somebody check on my code please? I've attached it for reference.

Thank you!
Attached Files
↧

Copy data from closed workbook

December 24, 2015, 1:17 pm
$
0
0
Hello:

I have 2 files Source.xls and Destination.xls, both files located at C:\Temp1

Source file is closed.
I need VB Code in Destination file to copy data from closed Source File sheet ("Impdata"), range C5: I100 to Destination file "Summary" Sheet at M5.

I have used below code in the past but does not wnat to work this time.

Code:
RowC = 5
ColsCnt = 7
RowsCnt = 96
Set SrcRng = x1W1.Sheets("ImpData").Range("C5:I100").Resize(RowC)
Worksheets("Summary").Range("M5").Resize(RowsCnt, ColsCnt) = SrcRng.Value
Let me know if any questions/
Thanks
Riz
↧
↧

[SOLVED] Get data from all sheets in specific way

December 24, 2015, 1:32 pm
$
0
0
Hello everybody
I have several sheets (reach to 50 sheets) but I attached a sample of five sheets only
In sheets("Final") I have posted two examples of the expected results

Simply to loop through all the sheets ..
In the used range , find the cells colored in white or in red .. then extract the subject from row 19 which is related to the white cells

For example In sheets("Sheet2") ..
--------------------------------
cell AP23 or AO23 are colored in white so first grab the school name which is "School B"
and then grab the subject related to that cell which is "Tafseer"
finally get the total number of students which is here 1
Attached Files
↧

Sort does not delete blank rows

December 24, 2015, 2:36 pm
$
0
0
It works fine till I cut rows to move to another sheet...The empty rows do not move to the bottom of the sheet and info to the top?

Code:
Sub Macro6()
'
' Macro6 Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
    Range("B1").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A2:E6")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Thanks
↧

[SOLVED] Copy each row from specific columns to another worksheet if criteria is met

December 24, 2015, 3:16 pm
$
0
0
Sub Services()

Dim i, x As Long
Dim airport As String
Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Raw Data")
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Services")

x = 11
airport = "BM"

For i = 2 To 500:
If ws1.Cells(i, 9) = airport Then
Range(ws2.Cells(x, 1), ws2.Cells(x, 2), ws2.Cells(x, 3), ws2.Cells(x, 4), ws2.Cells(x, 5)).Value = 'This is where it errors' -->Range(ws1.Cells(i, 1), ws1.Cells(i, 2), ws1.Cells(i, 4), ws1.Cells(i, 7), ws1.Cells(i, 8)).Value
x = x + 1
End If
Next i

End Sub



The error: It highlights "Range" and comes up with a message saying "wrong number of arguments or invalid property assignment". NEED HELP ASAP PLEASE. Thanks in advance!
↧
Viewing all 50236 articles
Browse latest View live
Search