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

Macro For Searching and Counting

May 14, 2014, 2:02 am
$
0
0
Example.xlsm I've created a spreadsheet for dealing with Product quantities, I've got several different sheets:

Summary Page - This is where all the products show up with total amounts etc.
Item sheets - Sheets where info is contained for each item, might be called 01A, 01B etc.
Data Fields - where users input product info so they can then just used drop down menus on the item sheets to make it quicker
Then some other sheets that would normally be hidden that just contain things that are of use to me!

I have attached the spreadsheet with as little nonsense on as possible!

At the moment I have a formula that searches specified sheets (have to hand write sheet names on Data Fields page) for the product description, then adds up the corresponding quantity to give the total on the summary page.

But what I want is a Macro that will search ALL sheets except some specified ones (Summary Page, Data Fields etc.) so that if the user needs to add in another item sheet or remove one it will automatically know, because currently I have to change the formulas by hand.

Please let me know if any clarification is needed. Any help would be appreciated, this is the last piece of my puzzle!
↧
Search

Script to transfer from MS Word form to EXCEL

May 14, 2014, 2:11 am
$
0
0
Hi all,
I trying to transfer data from a word form to EXCEL using the following script but getting error

"-2147217900: Syntax error in INSERT INTO statement". Really appricate if anyone could help?

Sub TransferToExcel()
'Transfer a single record from the form fields to an Excel workbook.
Dim doc As Document
Dim strForename As String
Dim strSurname As String
Dim strLocation As String
Dim strPersonnelNumber As String
Dim strGradeTitle As String
Dim strContactNumber As String
Dim strContactEMail As String


Dim strSQL As String
Dim cnn As ADODB.Connection


'Get data.
Set doc = ThisDocument
On Error GoTo ErrHandler
strForename = Chr(39) & doc.FormFields("txtForename").Result & Chr(39)
strSurname = Chr(39) & doc.FormFields("txtSurname").Result & Chr(39)
strLocation = Chr(39) & doc.FormFields("txtLocation").Result & Chr(39)
strPersonnelNumber = Chr(39) & doc.FormFields("txtPersonnelNumber").Result & Chr(39)
strGradeTitle = Chr(39) & doc.FormFields("txtGradeTitle").Result & Chr(39)
strContactNumber = Chr(39) & doc.FormFields("txtContactNumber").Result & Chr(39)
strContactEMail = Chr(39) & doc.FormFields("txtContactEMail").Result & Chr(39)





'Define sql string used to insert each record in the destination workbook.
'Don't omit the $ in the sheet identifier.
strSQL = "INSERT INTO [Sheet1$]" _
& " (Forename,Surname,Location,PersonnelNumber,GradeTitle,ContactNumber,ContactEMail)" _
& " VALUES(" _
& strForename & ", " _
& strSurname & ", " _
& strLocation & ", " _
& strPersonnelNumber & ", " _
& strGradeTitle & ", " _
& strContactNumber & ", " _
& strContactEMail_ & ")"
↧
↧

Delete Row if date in Column B is = or > than

May 14, 2014, 2:23 am
$
0
0
Hi,

As title says i would like to Delete Row if date in Column B is = or > than A1.

Attached is a sample worksheet.

Kind Regards

Chris
Attached Files
↧

[SOLVED] Updating cells in two separate worksheets

May 14, 2014, 2:24 am
$
0
0
Hi Guys,

I need to find a way of updating cells in two separate worksheets. The cell address can vary.

Right now I am using a “button“ which when clicked updates the cell value by an increment.

Code:
ActiveCell.offset(0, 0).value = ActiveCell.offset(0, 0).value + 0.0001
The second worksheet is a kind of duplicate so I am hoping that if I were to randomly put the cursor into say cell (B:3) in worksheet1 and click the button it will update the cell (B:3) in worksheet1 AND the cell (B:3) in worksheet2.

I guess I am trying to get is the address of where the cursor is and then apply it to the second worksheet.

Any help would be very much appreciated.
↧

Delete chartobject without deleting ALL charts on sheet

May 14, 2014, 2:24 am
$
0
0
Good day I have created various charts using the the following code and place them on to sheet 2. However, I want to delete 1 chart from the sheet and not all of them. How do I delete a specific chart?


Code:
Set cht = Sheets("Sheet2").ChartObjects.Add(Left:=2, Width:=580, Top:=774, Height:=355)

With cht

.Chart.SetSourceData Source:=Sheets("Sheet1").Range(SAIDIyearStart, SAIDITargetEnd), Title:="SAIDI CNC"
↧
↧

[SOLVED] Check cell to see if blank if so move value from next column in to the cell.

May 14, 2014, 2:29 am
$
0
0
Hi All,

I am converting a PDF to an Excel Sheet. When i do this it merges alot of cells together. When I unmerge the cells some times the data in Column A is in A and some times its in B the PDF is an invoice so can be variable in the number of cells in use. I need to find missing date from Column A in Column B and move it back in to Column A.

Example.xlsx Basic Example sheet attached

Appreciate any help given thanks.

Richard.
↧

Pop up messages according the date of the month

May 14, 2014, 2:47 am
$
0
0
Hello

I use this code(Provided by Mr Alan) that works fine.
Code:
Option Explicit
Private Sub Workbook_Open()
Dim sh As Worksheet
Set sh = Sheets("Sheet2")

If Day(Now()) = 10 Then
    MsgBox Join(Application.WorksheetFunction.Transpose(sh.Range("A1:A10").Value), Chr$(10))
    ElseIf Day(Now()) = 15 Then
        MsgBox Join(Application.WorksheetFunction.Transpose(sh.Range("B1:B10").Value), Chr$(10))
        ElseIf Day(Now()) = 20 Then
            MsgBox Join(Application.WorksheetFunction.Transpose(sh.Range("C1:c10").Value), Chr$(10))
            ElseIf Day(Now()) = 25 Then
                MsgBox Join(Application.WorksheetFunction.Transpose(sh.Range("D1:D10").Value), Chr$(10))
                ElseIf Day(Now()) = 30 Then
                    MsgBox Join(Application.WorksheetFunction.Transpose(sh.Range("E1:E10").Value), Chr$(10))
End If

End Sub
My problem is that when the specific dates of the code are in weekends or Holidays, user does not see the messages and forget to do the duties.

I need if specific days of the month that appear in the code(10,15,20,25,30) are in weekends OR Holidays the pop up message to appears the last working date BEFORE that day.

In My example as Tomorrow date is in the Holidays List, the message for DAY 15 of the month should appear today.

Thanks in advance for any assistance here!:)
Attached Files
↧

Run-time error:'-2147217887(80040e21)': ODBC driver does not support the requested proper

May 14, 2014, 2:49 am
$
0
0
please let me know i am stuck here

Code:
Dim dbconn As New ADODB.Connection

Dim totColumns, totRows, i, j, WDS_id
Dim prBatchName, prTableQry, inTableQry, prTableQry1, dbQry
Dim rs As New ADODB.Recordset

Sheet1.Activate
prBatchName = "tblProd_AGR_007"

totColumns = ActiveSheet.Cells(2, 1).CurrentRegion.Columns.count
totRows = ActiveSheet.Cells(2, 1).CurrentRegion.Rows.count

prBatchName = ActiveSheet.Cells(2, totColumns + 1).ID
dbconn.Open strConn
rs.Open "select * from " & prBatchName, dbconn, adOpenStatic, adLockOptimistic  ->[iam getting error here]
    For j = 3 To totRows
        WDS_id = ActiveSheet.Cells(j, 1)
        rs.Find "WDS_ID=" & WDS_id
       
        For i = 2 To totColumns
        rs(ActiveSheet.Cells(2, i).ID) = ActiveSheet.Cells(j, i)
        Next
        rs.Update
 
    Next
rs.Close
dbconn.Close
MsgBox "Data updated sucessfully"
↧
Search

Format userform textbox so that the value is greater or equal to zero

May 14, 2014, 2:53 am
$
0
0
Hello,

I have a sample userfrom textbox that accepts numeric values. When a command button is clicked the textbox value increases +1. When a togglebutton is true and the command button is clicked the textbox value is -1. I want to be able to place a limit whereby the textbox value cannot be less than zero, ie no negative number. Should I be placing a txtformat to the textbox?

value decrease.xlsm

Thank you,
Gal403
↧
↧

Enabling hide/unhide rows in protected sheet

May 14, 2014, 2:56 am
$
0
0
Dear Experts, I have been supported by you many times in this forum for various macro requirements, and I am thankful to you all. This time I am with a similar request.

I have a simple worksheet, which is protected to maintain the drop down list intact in rows 3:150. In these rows, many of them may be empty. I would like to activate hide / unhide rows option, inspite of the sheet protected. Can you please help me out?

Many thanks for the support.

gm2612
↧

Lookup folder from cell text, then save excel file in this folder

May 14, 2014, 3:00 am
$
0
0
Hi,

I have been using this forum for a while now. Usually I can find similar problems and fixes in order to fix my problem. This time however I cannot find a suitable solution to this problem:

I have alot of project folders on my harddrive. All in format: I:/12345-costumer-projectname/
the five digits are unique for each project.

I make calculations for these projects using an excel file. In this excel I also type the projectnumber (cell J2)
Now i would like to make a button. When pressed, it checks the projectnumber cell J2, looksup the corresponding folder and saves the excelfile in PDF format in this folder.

I have found macro to find files in folders, but none which do the above.
Can anyone point me in the right direction? Thanks alot for your help!

Best regards,
Bob
↧

VBA Combined Graph

May 14, 2014, 3:28 am
$
0
0
Hi, I wonder whether someone could help me please.

I've put together the following script which applies a graph to a given sheet.

Code:
Sub add_chart(ws As Worksheet)
   
    Dim ChtOb As ChartObject
    Dim RngToCover As Range
    Dim sShapeName As String
   
    Sheets("All C&R Forecast").Select
    With ActiveSheet.ChartObjects.Add _
        (Left:=48, Width:=468, Top:=260, Height:=239)
        .Chart.ChartType = xlAreaStacked
        .Select
    End With
   
    With ActiveChart.SeriesCollection.NewSeries
        .Values = "='All C&R Forecast'!R8C3:R8C14"
        .XValues = "='All C&R Forecast'!R7C3:R7C14"
        .Name = "=""Staff FTE"""
        .Border.ColorIndex = 5
        .Border.Weight = xlMedium
        .Border.LineStyle = xlContinuous
        .ChartType = xlLineMarkers
    End With
   
    With ActiveChart.SeriesCollection.NewSeries
        .Values = "='All C&R Forecast'!R9C3:R9C14"
        .XValues = "='All C&R Forecast'!R7C3:R7C14"
        .Name = "=""Direct Activities"""
        .Border.ColorIndex = 5
        .Border.Weight = xlMedium
        .Border.LineStyle = xlContinuous
    End With

    With ActiveChart.SeriesCollection.NewSeries
        .Values = "='All C&R Forecast'!R10C3:R10C14"
        .XValues = "='All C&R Forecast'!R7C3:R7C14"
        .Name = "=""Enhancements"""
        .Border.ColorIndex = 5
        .Border.Weight = xlMedium
        .Border.LineStyle = xlContinuous
    End With
   
    With ActiveChart.SeriesCollection.NewSeries
        .Values = "='All C&R Forecast'!R11C3:R11C14"
        .XValues = "='All C&R Forecast'!R7C3:R7C14"
        .Name = "=""Indirect Activities"""
        .Border.ColorIndex = 5
        .Border.Weight = xlMedium
        .Border.LineStyle = xlContinuous
    End With

    With ActiveChart.SeriesCollection.NewSeries
        .Values = "='All C&R Forecast'!R12C3:R12C14"
        .XValues = "='All C&R Forecast'!R7C3:R7C14"
        .Name = "=""Overheads"""
        .Border.ColorIndex = 5
        .Border.Weight = xlMedium
        .Border.LineStyle = xlContinuous
    End With
   
    With ActiveChart.SeriesCollection.NewSeries
        .Values = "='All C&R Forecast'!R13C3:R13C14"
        .XValues = "='All C&R Forecast'!R7C3:R7C14"
        .Name = "=""Projects"""
        .Border.ColorIndex = 5
        .Border.Weight = xlMedium
        .Border.LineStyle = xlContinuous
    End With

    With ActiveChart.Legend
        With .Font
            .Name = "Calibri"
            .FontStyle = "Regular"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .Background = xlAutomatic
        End With
    End With
   
    With ActiveChart.Axes(xlValue).TickLabels
        With .Font
            .Name = "Calibri"
            .FontStyle = "Regular"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .Background = xlAutomatic
        End With
    End With
   
    With ActiveChart.Axes(xlCategory).TickLabels
    .NumberFormat = "mmm yy"
        With .Font
            .Name = "Lucida Sans"

            .FontStyle = "Regular"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .Background = xlAutomatic
        End With
    End With
   
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Flexible Resources KPI"
    End With
   
    sShapeName = ActiveChart.Parent.Name
   
    With ActiveSheet.Shapes(sShapeName)
        .ScaleWidth 1.14, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 1.07, msoFalse, msoScaleFromTopLeft
    End With
End Sub
The problem I have is this line
Quote:
.ChartType = xlLineMarkers
I'm trying to apply a line chart type to the first data series, but when I run the code, all of the data series are changed to line chart type. and I despite recording the macro, I'm not sure how to overcome this.

I just wondered whether someone may be able to look at this please and let me know where I'm going wrong.

Many thanks and kind regards

Chris
↧

For next sheet +1

May 14, 2014, 3:49 am
$
0
0
Hi

I have one big sheet, one summary page, which is to be a summary journal of all the other area managers journals

I have basic bits done but I am stuck flicking from the managers journal, then pasting it to the summary, then going to the next managers journal sheet.

the summary sheet is on sheet(3) or "Summary Journal", the managers journals are from sheets(5) and above.

The amount of managers change every month and I have to sumif their data, which I have already done.

I need to flick from sheets(5) to the "Summary Journal", do my stuff, then to sheets(6), then to the "Summary Journal", then Sheets(7) and so on

Im assuming I need to, when on Sheets(5) I need to dim the sh = sh+1 or something like that
Code:
Dim sh As Worksheet
    Dim wb As Workbook
   
   

    For Each sh In ActiveWorkbook.Worksheets
        With sh
            Sheets(5).Select


    Range("N5:T5").Select ' this is just pasting my workings etc
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Summary Journal").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

       
    sh = sh + 1 ' my problem area

    End With
    Next sh
↧
↧

AutoFit columns with macro

May 14, 2014, 3:59 am
$
0
0
Hi all I am trying to program a macro to AutoFit 29 columns on 3 different sheets. However it keeps coming up with "run-time error '1004' select method of range class failed".
here is the code if it helps
Code:
Private Sub CommandButton2_Click()

'TPS
Sheets("tps1").Select
Columns("A:AD").Select                          'here is where it goes wrong
Columns("A:AD").EntireColumn.AutoFit

'Clean Macro
Range("B:F,Q:Q,W:W,X:X,Y:Y,AD:AD").Select
Selection.Delete Shift:=xlToLeft
Columns("D:E").Select
Selection.EntireColumn.Hidden = True
Range("A29").Select

End Sub
Please help.

Kind regards

Deano
↧

Run macro after leaving shape editing mode

May 14, 2014, 4:08 am
$
0
0
Hello,

I've got a macro function which calculates the area of a polygon freeform using the 'shoelace'-methode. I would like to excute this function after i leave the shape editing mode.

For example: I have a square, freeform shape. By right-mouseclick I can edit the shape nodes. If i drag one of the nodes of the square to another position and click outside of the shape, the new shape is updated. Right, on that moment i would like to trigger my macro to recalculate the area.

Is there an event in excel to aim for, like the Worksheet.change-event or something similar? Can anybody push me in the right direction?
↧
Search

Macro to enter data in next column if previous column is filled.

May 15, 2014, 7:38 am
$
0
0
Hey guys, I've been trying to figure this out to make things more automated and streamlined at my work. Basically I've been working on this order sheet where you enter data in the current order column, and then when you click a button, it takes all of that information and adds it to the order history to the right. I've been messing around in a less sensitive workbook trying to get this to work but I'm at a point now where the macro I have will copy the appropriate data to the first column, but will not move on to the next column. It's also very important that the whole row of values is copied to the next blank column, IE if a space is left blank in the previous order, the next set cannot fill that blank space in, everything just goes to the next wholly empty column.

order history.xls

A copy of that order sheet so you can see what I'm trying to do and how to apply it. Here's the macro I've shoddily assembled here. I know it's not terrific and I'm sure somewhat redundant but I am no excel expert, hence, I come here.

Code:
Sub copy_paste_Click5()
Application.ScreenUpdating = False
Worksheets("Order History").Range("B10:B188").Copy
Worksheets("Order History").Range("E10:E188").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
If Application.WorksheetFunction.CountA("E:E") = 0 Then
[F10].Select
Else
On Error Resume Next
Columns(1).SpecialCells(xlCellTypeBlanks)(1, 1).Select
If Err <> 0 Then
On Error GoTo 0
[A65536].End(xlUp)(2, 1).Select
End If
On Error GoTo 0
End If
End Sub
Hopefully someone here is enlightened enough to help me out with what seems like a fairly simple issue.
↧

Manipulating range from listbox

May 15, 2014, 7:39 am
$
0
0
Hi,
I'm not sure if it's possible but I'm trying.. it may be a bit tautological. :eek:
I've got a range (say a1:g10) which is being displayed by a listbox (which contains 7 columns) placed in userform.
Within this listbox I can easily "mark" with the mouse a specific row (say a2:g2), question: can I delete that marked row? in other words is it possible to "affect" the original "database" (a1:g10) from the listbox?
↧
↧

VBA Error while copying files into a folder if the file is already exist

May 15, 2014, 8:15 am
$
0
0
Hi All,

I am using below code to extract information from various xlsm files into one file. And once information is copied into master file the source file gets moved into a folder called imported.

It works perfectly fine but if the file is already exist in imported folder then the code gives error.

Ideally I like it to create a copy of the file (save as version 2).

Any help would be appreaciated.

Code:
Sub Consolidate_Workbooks()

'Summary:    Open all Excel files in a specific folder and copy
'            one sheet from the source files into this master workbook
'            naming sheets for the names of the source workbooks
'            Move imported files into another folder
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long, shtAdd As String, ShtName As Worksheet
Dim wbData As Workbook, wbkNew As Workbook

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
 
    Set wbkNew = ThisWorkbook
    wbkNew.Activate
 
'Path and filename (edit this section to suit)
    fPath = Range("B16").Value          'remember final \ in this string
    fPathDone = fPath & "Imported\"    'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.xlsm")      'listing of desired files, edit filter as desired

'Import data from each found file
    Do While Len(fName) > 0
    'make sure THIS file isn't accidentally reopened
        If fName <> wbkNew.Name Then
       
        'This is the section to customize, what to copy and to where
        'Get name of workbook without extension
            shtAdd = Left(Left(fName, InStr(fName, ".") - 1), 29)
        'Open file
            Set wbData = Workbooks.Open(fPath & fName)
           
        'Rename sheet and copy to target workbook
            wbData.Sheets("PR1").Name = shtAdd
            wbData.Sheets(shtAdd).Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
         
        'close source file
            wbData.Close False
        'move file to IMPORTED folder
            Name fPath & fName As fPathDone & fName
        'ready next filename, reassert the list since a file was moved
            fName = Dir(fPath & "*.xlsm")
        End If
    Loop

ErrorExit:    'Cleanup
    Application.DisplayAlerts = True        'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
    Exit Sub


End Sub
Error is in the following line as it tries to copy same file into the folder.

'move file to IMPORTED folder
Name fPath & fName As fPathDone & fName

Thanks,

Egemen
↧

[SOLVED] Delete the rows if condition match

May 15, 2014, 8:25 am
$
0
0
hello
i have data in range A1:A200, i want to delete the entire rows if condition met

i want if cell("P2").value = < 43 than delete the entire rows from a51:a200

i want if cell("P2").value = < 85 than delete the entire rows from a100:a200

i want if cell("P2").value = < 127 than delete the entire rows from a149:a200


thanx alot
↧

Matching text from 2 different worksheets and paste one worksheet column to another

May 15, 2014, 8:26 am
$
0
0
I am brand new to forums, and new to Excel. I hope I word this correctly.

I have 2 worksheets. Worksheet 1 is a master worksheet with designated columns for words in each language (column 1 English, column 2 Spanish, column 3 French). Worksheet 2 has only English. My goal:

I would like to take worksheet 2 with the English only and match with the English from Worksheet 1 to find the French words, then copy/paste the corresponding French column from worksheet 1 and paste in a new column next to the English words in worksheet 2.

Any help would be greatly appreciated.

M
↧
Viewing all 49934 articles
Browse latest View live
Search