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

Automatically increment single cell from 15 to 150

$
0
0
Hi guys,

I had a question remark VBA excel. I did some research on how to increment a single cell from for example 15 to 150 but i cant find anything.
What i want is, i want a button in a userform that increment cell B2 from 15 to 100 fast but stops when cell B3 has a certain value

I hope someone can help me

thank you very much


Johan

Find all workbooks except thisworkbook

$
0
0
I have a file which is named/saved automatically by VBA as "fileA.xlsm".

When I enter data in its cell "data" then the file is automatically saved/named as "fileA - data.xlsm". Same when I enter a date in cell "date", the file is save as "fileA - data - date.xlsm"

what I want is that each time the file is saved as new name, it goes to the specific folder and delete the previous name.

Ex: I am on file "fileA.xlsm", I enter data in the cell "data", here the file is saved as "fileA - data.xlsm". Then i enter data in the cell "date" here the file is saved as "fileA - data - date.xlsm". Here I would like my code to go and find the files "fileA.xlsm" and "fileA - data.xlsm" and delete them.

The below code works until it reaches the activate workbook (""fileA - data - date.xlsm") and then of course I get a "error70 - permission denied".

How should I amend it to say basically,
-go to folder "test"
- find all the files name containing "fileA" (except activeworkook)
- delete them =delete "fileA.xlsm" and "fileA - data.xlsm" but not "fileA - data - date.xlsm".



Code:

sub sbDeletetingAFile()
   
    Dim sPath As String
    Dim OLDNAME As String
    Dim bNoFiles As Boolean
   
    'Source File Location
    sPath = "C:\Users\mciavaldini.TAMOILCY\Desktop\TEST\"
   
    OLDNAME = "*fileA*.XLSM"
   
    On Error Resume Next
        Kill sPath & OLDNAME & ".xlsm"
        bNoFiles = Err.Number <> 0
    On Error GoTo 0
   
   
End Sub

THank you in advance for your time

Giving VBA UserForm task bar icon

$
0
0
I am trying to give my Excel UserForm application a task bar icon as on load it hides the Excel workbook which make the form(s) easy to lose behind other windows. I have a .png or an .ico file which I would like to use as the icon. The image can either be just in the folder with the Excel file but if it could be embedded some way into the workbook that would be preferable.

Thanks for any help!

Using VBA for extracting data from specific Google Searches

$
0
0
Hello all,

I am looking for a code that uses the data in cells to do a Google Search and then resultantly extract the Address and Telephone of a company.

Upon some sample searches, I have found that the majority of these companies appear first time with the 'Business Details' box at the side of Google. This is the data I would like extracted into Excel.

Please let me know if anything is unclear and as always, I appreciate your help!

Many thanks.
Attached Files

Difficulty using Combobox to open another window/user form

$
0
0
Hi,

I have a userForm and would like to activate another 2 windows/dialogue box. The first when I select'Suspension'
and the second when I select 'Solid'. The reason being is that there are different considerations throughout the process,
hence the need for a different userform. How could I select an option that opens, say, a userform 3.


Code:

Private Sub UserForm_Initialize()

    With UserForm2.ComboBox1
     
        .AddItem "SOLID"
        .AddItem "SUSPENSION"
        .AddItem "SUSPENSION AXLE FLUTED"
        .AddItem "SUSPENSION UNITS"
        .AddItem "HUB/STUB/BRAKE ASSEMBLY"
        .AddItem "HALF AXLE"
        .AddItem "BOOGIE"
    End With


End Sub

How to set different colors for individual points in a serie?

$
0
0
This is probably very basic, but I am stuck with this problem: I have lots of data series consisting each of 2 data points. I would like to have all first points to be white circles, and all second points to be filled in black.

I tried this code:

HTML Code:

Sub LoopThroughCharts()

Dim cht As ChartObject
Dim ser As Series

  For Each cht In ActiveSheet.ChartObjects
    For Each ser In cht.Chart.SeriesCollection
        ser.Format.Line.ForeColor.RGB = 0
        ser.Points(1).MarkerBackgroundColor = White
        ser.Points(2).MarkerBackgroundColor = Black
             
    Next ser
  Next cht
 
End Sub

It runs, I don't get any error messages, but my points are still all filled in black (their initial state). What's wrong in my code?

Thanks in advance!

VBA Macro For Creation of Summary File from Workbooks

Inserting column data under other column data vba

$
0
0
Hi I need a little assistance please. I am working on a worksheet macro and:

I need to copy data from columns F,G,H,I,J and put in the next available row in columns A,B,C,D,E.

Then

copy the data from columns K,L,M,N,O and put in the next available row in columns A,B,C,D,E.

Then

copy the data from columns P,Q,R,S,T and put in the next available row in columns A,B,C,D,E.

Then

copy the data from columns U,V,W,X,Y and put in the next available row in columns A,B,C,D,E.

Appreciate any help.

Search & Replace in email body when sending an email with Excel

$
0
0
Hi everyone,

I'd like to ask for your help with an issue I'm having with a project.

I have an Excel document with 2 tabs:

- Sheet 1 where the user can fill in their report and comment on their tasks.
- Sheet 2 that displays the information from Sheet 1 with a layout appropriate for an email.

Then, the following macro prepares and sends an email with Outlook:

Quote:

Dim xRng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim wDoc As Object
Dim wRng As Object

Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
If OutApp Is Nothing Then
MsgBox "Outlook is not accessible"
Exit Sub
End If
End If

'Get the contents
On Error GoTo Errorhandler

LastRow = Worksheets("Email").Columns(1).Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row

Set xRng = Worksheets("Email").Range("A1:J" & LastRow).SpecialCells(xlCellTypeVisible)

'Now create a mail
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = Range("EmailTo").Value
.CC = Range("EmailCc").Value
.Attachments.Add ActiveWorkbook.FullName
.Subject = "")
Set wDoc = OutMail.GetInspector.WordEditor
Set wRng = wDoc.Range

'Copy and paste the contents
xRng.Copy
wRng.Paste

.Display
.Send
My issue:

In the Sheet 2 (where the data are copied from and then pasted in the email body), there is a cell listing multiple company names (based on what the user said in their report) and these company names could be anything (no preset list).
I.e. "List of companies: Company 1, Company 2, Company 3"

I would like each company to be hyperlinked with a URL like "www.test.com/Company_Name". The URL is fixed and only "Company_Name" varies.

Unfortunately I cannot list all companies in separate cells.

My question is:

- After my macro has pasted the email content (from Sheet 2) into the email body, is there a way I could hyperlinked the companies directly in the email body with a search & replace command within the email body and replace each company name with a link? Basically replacing Company with Company

- Alternatively, is there a way I could instead display the company names in the Excel cell with some HTML codes that could be interpreted as linked words when being pasted into the email editor?


I hope that makes sense. I know this is quite a tricky operation so please let me know if you need additional information.

Thanks a lot in advance for your help!

Note: This post has previously been posted here but since I had no reply, I'm asking here. I hope this is OK.

VBA Copy And Paste From Column A Sheet 1 To Sheet 2 Row 1

$
0
0
Hi Guys,

I was just wondering if you could help me as I am really new to this.

I was wondering if it is possible to have a Macro run through Column A Sheet 1 Copying and pasting each value on to Sheet 2 Row 1 and then naming each of these ranges based on the value that it has copied.

but the range size would need to be A1:C10, D1:F10, G1:I10 and so on......

Any help would be greatly appreciated

Many thanks
Jamie

Excel Macro to extract field values in multiple PDF form to Excel sheet

$
0
0
Hi,

Having more PDF forms, i want to get the field values from multiple PDF forms located in one folder to Excel sheet in row wise.

Guide to extract PDF form field values in to excel sheet.

Thanks

Sort out "Fail" Text from Columns

$
0
0
Dear Masters,

I need simple macro for sort out by "Fail" text no.s to another Row.please find sample file.

Thank you,
Best Regards.
Attached Files

do without a loop

$
0
0
Howdy Folks

I keep getting the Compile error up:

Loop without Do

when I write the code below:

But I do do a Do :) .Can anybody see what I am doing wrong.

Excel help files said..

A do loop must begin with a Do statement.This error has the following cause and solution.

You have an unterminated Loop block nested within another loop
Check to verify that the coreect Do...Loop syntax is used.


But I only have one loop so thats a bit confusing




Code:

Sub loopanumber()

      Sheet1.Range("A1").Select

      Do Until ActiveCell.Value = ""

      Sheet1.Range("A1").End(xlDown).Offset(1, 0).Select
            If ActiveCell.Value = 4 Then
ActiveCell.Offset(0, 3).Value = 4

      Loop

Any help much appreciated.
Barrow in furness

VBA Code causing a new IE to open after every search

$
0
0
Hello all,

Would anyone be able to tell me the issues with this code? It runs fine and grabs what is needed, but resultantly it opens up multiple IE processes in the background up until CPU usage reaches 100% and then it crashes.

Any help would be appreciated :)

Also as a side note, I was looking to grab the heading as well by adding in a cell offset in Column 4 but it was just leaving it blank. I take it I had inspected the element incorrectly?

Code:

Sub googladressSearch()
    Dim IE As Object, doc As Object, Comp As Object, addr, cel As Range, URL As String
   
    With ActiveSheet
        .UsedRange.Offset(1, 1).ClearContents
   
        For Each cel In .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).row).SpecialCells(2)
       
          URL = "https://www.google.co.uk/?gfe_rd=cr&ei=dznZV9knx9TyB-KtvfgB&gws_rd=ssl#q=" & cel
       
       
          Set IE = CreateObject("InternetExplorer.application")
            IE.Visible = 0
            IE.Navigate URL
           
            Do While IE.Busy Or IE.ReadyState <> 4
                DoEvents
            Loop
           
            Set doc = IE.Document
       
          Application.Wait (Now + TimeValue("0:00:05"))
            Set Comp = doc.getElementsByClassName("_mr")
            If Not Comp Is Nothing Then
                       
                    For Each addr In Comp
               
                        If (InStr(1, addr.innerText, "address", 1)) > 0 Then
                            cel.Offset(, 1) = Split(addr.innerText, ":")(1)
                        ElseIf (InStr(1, addr.innerText, "phone", 1)) > 0 Then
                            cel.Offset(, 2) = Split(addr.innerText, ":")(1)
                        ElseIf (InStr(1, addr.innerText, "menu", 1)) > 0 Then
                          cel.Offset(, 3) = Split(addr.innerText, ":")(1)
                        End If
                    Next addr
            End If
        Next
End With
End Sub

[SOLVED] Force ListBox to show the exactly word entered in results

$
0
0
Hi all. I have this listbox code
Code:

Private Sub CommandButton18_Click()
Application.ScreenUpdating = False
If Me.ComboBox7.Value = "" Then Exit Sub
Me.ListBox1.Clear
j = 1
Filas = Range("A1").CurrentRegion.Rows.Count
For i = 2 To Filas
    If LCase(Cells(i, j).Offset(0, 4).Value) Like "*" & LCase(Me.ComboBox7.Value) & "*" Then
        Me.ListBox1.AddItem Cells(i, j)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, j).Offset(0, 2)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Cells(i, j).Offset(0, 28)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Cells(i, j).Offset(0, 1)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Cells(i, j).Offset(0, 3)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Cells(i, j).Offset(0, 8)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Cells(i, j).Offset(0, 9)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = Cells(i, j).Offset(0, 10)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = Cells(i, j).Offset(0, 26)
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = Cells(i, j).Offset(0, 27)
    Else
    End If
Next i
Label15.Caption = ListBox1.ListCount
Exit Sub
Application.ScreenUpdating = True
End Sub

With this
Code:

If LCase(Cells(i, j).Offset(0, 4).Value) Like "*" & LCase(Me.ComboBox7.Value) & "*" Then
it search a word introduced into the ComboBox7. The options are loaded with this
Code:

ComboBox7.AddItem "A"
ComboBox7.AddItem "A-r"
ComboBox7.AddItem "B"
ComboBox7.AddItem "B-r"
ComboBox7.AddItem "C"
ComboBox7.AddItem "D"
ComboBox7.AddItem "E1"
ComboBox7.AddItem "E2"
ComboBox7.AddItem "Beca"

My problem is: if I select "A-r", also search the "A" content. Same with "B" and "B-r". Any way to force only to search exactly "A-r" or "A" or "B-r" or "B" using the same commandbutton click?

Thanks for all

VBA mixed references

$
0
0
I need a very simple macro which when activated copies the value in the b col in the current row. My problem is that I need to be able to activate the macro regardless of which cell is currently active so the col ref needs to be absolute, but the row ref needs to be relative. In formulae to be replicated to other cells it's very easy: $B1, $B2 etc, is it possible in VBA? if so how?

I've found a couple of things that mention mixed references but they all refer to one reference that's entirely relative working with another that's entirely absolute, I want one reference that has one of each element.

Thanks muchly.

[SOLVED] Last row in different sheet

$
0
0
Hi guys,
just simple task for you :) this code works well :
Code:

lastcell = Cells(Rows.Count, "B").End(xlUp).Row
but how can I make it to ask for last cell in different sheet? this doesnt work :
Code:

lastcell = Cells(Rows.Count, "data!B").End(xlUp).Row
but there has to be simple solution ... :) thank you

Pop up box depending on criteria entered across multiple columns

$
0
0
Good morning,

I have a spreadsheet where I need a pop-up box to appear if the value 'x' is entered. However, I did a different pop-up box for each column.


I can get a pop up to appear in one one area, but I don't know how to duplicate for the others (do I copy & past the same code in full, or just bits?). Apologies but this is my first time using VBA so all a bit confusing.

Example below:

If 'x' is entered in Columns A1:B35, text box says '"column one information"
If 'x' is entered in Column C1:D35, text box says "column two information" etc etc etc

Spreadsheet VBA.JPG

This is the code I am currently using

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
On Error Resume Next
Set Rg = Application.Intersect(Target, Range("A1:B35"))
If Not Rg Is Nothing Then
If Target.Value = "x" Then
MsgBox "text to show in message box"
Exit Sub
End If
End If
End Sub
Private Sub Worksheet_selectionChange(ByVal Target As Range)
Dim xCell As Range, Rg As Range
On Error Resume Next
Set Rg = Application.Intersect(Target, Range("A1:B35"))
If Not Rg Is Nothing Then
For Each xCell In Rg
If xCell.Value = "x" Then
MsgBox "text to show in message box”
Exit Sub
End If

Change the format of the dump

$
0
0
Hey All,

VBA learner here

I need a MACRO where i can convert one format of SAP dump to another format. I am attaching current.xlsx worksheet to have a glance of the SAP dump.
I am also attaching the desire format of the Dump needed. I am analysing the stock level of a all product for 10 days.

The product in the file has only 6 products but in reality i have to deal with more than 200 products
Attached Files

Copy data to next empty row

$
0
0
HI

I have a spread sheet with data and I want to copy data into another sheet ( which I have working) but I want it to copy the next empty row, as at the moment it just over rights the data all the time. can anyone pleas help.

here is what im using at the moment

Code:

xxxx Saves data from the travel form to the weekly report form xxxx
    Sheets(1).Range("c2").Value = ThisWorkbook.Sheets(1).Range("d8").Value & " " & ThisWorkbook.Sheets(1).Range("e8").Value & Chr(10) & ThisWorkbook.Sheets(1).Range("d9").Value & " " & ThisWorkbook.Sheets(1).Range("d9").Value
    Sheets(1).Range("d2").Value = ThisWorkbook.Sheets(1).Range("b15").Value
    Sheets(1).Range("e2").Value = ThisWorkbook.Sheets(1).Range("k15").Value
    Sheets(1).Range("d15").Value = ThisWorkbook.Sheets(1).Range("j9").Value
    Sheets(1).Range("f2").Value = ThisWorkbook.Sheets(1).Range("b17").Value
    Sheets(1).Range("g2").Value = ThisWorkbook.Sheets(1).Range("b20").Value
    Sheets(1).Range("h2").Value = ThisWorkbook.Sheets(1).Range("b23").Value
    Sheets(1).Range("i2").Value = ThisWorkbook.Sheets(1).Range("k26").Value & " " & ThisWorkbook.Sheets(1).Range("d26").Value & _
  ">" & ThisWorkbook.Sheets(1).Range("e26").Value & Chr(10) & ThisWorkbook.Sheets(1).Range("k27").Value & " " & ThisWorkbook.Sheets(1).Range("d27").Value & ">" & ThisWorkbook.Sheets(1).Range("e27").Value

Viewing all 50103 articles
Browse latest View live