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

Search if value exists in range

$
0
0
Okay well this is the code I have:

Sub Copy_RawData_To_ServicesBM()

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")
Dim c As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1

x = 11
airport = "BM"

With ws1
lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row
End With

For Each c In Worksheets("Product List").Range("E:E")
If c.Value = "Treatment" Then
If MyCount = 1 Then Set NewRange = c.Offset(0, -4)
Set NewRange = Application.Union(NewRange, c.Offset(0, -4))
MyCount = MyCount + 1
End If
Next c

For i = 2 To lastrow:
If ws1.Cells(i, 9) = airport And --->HERE<--- Then
ws2.Cells(x, 1).Value = ws1.Cells(i, 1).Value
ws2.Cells(x, 2).Value = ws1.Cells(i, 2).Value
ws2.Cells(x, 3).Value = ws1.Cells(i, 4).Value
ws2.Cells(x, 4).Value = ws1.Cells(i, 7).Value
ws2.Cells(x, 5).Value = ws1.Cells(i, 8).Value
x = x + 1
End If
Next i

End Function


I need to check if the value of ws1.Cells(i, 4) exists in NewRange. I would include this as a second parameter for the if statement. Ideally it would be like a boolean value like if it it exists then something = true and it proceeds with the code. Thanks you!

VBA code to show updated data in the listbox after the data is entered and button clicked

$
0
0
When the attached workbook's userform is opened, data is entered in the textbox and is saved to Sheet2 when the save button is pressed. Is there any additional code that I can include that can do the below:

After data is entered for any line of data, the save button is pressed and does the below:

1. Data saved to the record in sheet2 (the form already does this)
2. Send the entered data to the listbox so it is visible (i.e. updated) in the listbox in the relevant line

One way to show the new data in the listbox is to use code to close the form and then reopen the form but I don't want to use this method.

Would appreciate your input!
Attached Files

The application close button doesn't work after speicifc activity

$
0
0
Hello everyone
I will attach a file which has a userform .. Clikc ShowForm to show the form then click the command button with the caption "Data" that would activate that sheet and hide all other sheets
everything is ok till now .. Close the form

Now if I tried to close the application it doesn't respond ..is there a problem with the userform?

[SOLVED] Issue in login the website through Excel VBA code

$
0
0
Hi VBA Gurus,

I am sorry to disturb you but need your help on urgent basis. I am fresher and beginner in VBA coding and struggling to write the code to automate the login of one website, need your help. Please help me. I have written below code, it is opening the website page but after that doing nothing. If we are passing wrong username/password it should show error as well.

Code is attached in file.

Regards,
Mani
Attached Files

Help In IE Automation

$
0
0
I am trying automate website login.
I am able to add login value and password value but not able click submit.
Please help me to correct my code
Dim HTMLDoc As HTMLDocument
Dim MyBrowser As InternetExplorer
Sub MyGmail()

Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
On Error GoTo Err_Clear
MyURL = "https://www.mysein.schneider-electric.com/mysedv/login.do"
Set MyBrowser = New InternetExplorer
MyBrowser.Silent = True
MyBrowser.navigate MyURL
MyBrowser.Visible = True
Do
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = MyBrowser.document
HTMLDoc.all.Login.Value = "user1" 'Enter your email id here
HTMLDoc.all.Password.Value = "1111" 'Enter your password here
For Each MyHTML_Element In HTMLDoc.getElementsByTagName("input")
If MyHTML_Element.Name = "submit" Then MyHTML_Element.Click: Exit For
Next
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub

url FOR SOURCE - view-source:https://www.mysein.schneider-electri...ysedv/login.do

VBA: Put extra space before units (keywords) if space is not there

$
0
0
1. Search unit keyword "kg/unit1" "kg/unit2" "kg/unit3" "kg/unit4".

VBA: Put extra space before units (keywords) if space is not there(for example: 1000kg/unit4 should be 1000 kg/unit4. If there is a space keep it as it is.)

No extra spaces should appear in all sheets except sheet A.

2. vba: Put a space between all numbers if no space appear. For example if "if My age is18 Year" should result "if My age is 18 Year"

[SOLVED] Transfer data from multiple tables to another sheet

$
0
0
Hello everyone
In my file I have several tables as illustrated .. As for green cells, they have names "m.rep name" and I need to transfer only the tables that have names ..if the table has no name, it would not be transferred

The source is sheets("1") and the destination is sheets("data") ..
The data to be transferred highlighted in red font
I attached the expected results...

Thanks advanced for help
Attached Files

macro text columns

$
0
0
Hello to all,
I created with the macro recorder this macro:


Code:

Sub dividi()

Application.ScreenUpdating = False

'On Error Resume Next

If Cells(2, 1) = "" Then
'MsgBox "Devi PRIMA incollare i dati da suddividere", 0 + 16, "Attenzione"
MsgBox "You must FIRST paste data to be divided", 0 + 16, "Attenzione"
Exit Sub
End If

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 9), Array(22, 2), Array(41, 2), Array(94, 9)), _
        TrailingMinusNumbers:=True
    Range("A2").Select
   
Application.ScreenUpdating = True
   
End Sub


I enter in the macro further notice:


Code:

Sub dividi()

Application.ScreenUpdating = False

'On Error Resume Next

If Cells(2, 1) = "" Then
'MsgBox "Devi PRIMA incollare i dati da suddividere", 0 + 16, "Attenzione"
MsgBox "You must FIRST paste data to be divided", 0 + 16, "Attenzione"
Exit Sub
End If

If Cells(1, 1) > 0 Then
'MsgBox "dati già inseriti", 0 + 16, "Attenzione"
MsgBox "data already entered," 0 + 16, "Attenzione"
Exit Sub
End If


    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 9), Array(22, 2), Array(41, 2), Array(94, 9)), _
        TrailingMinusNumbers:=True
    Range("A2").Select
   
Application.ScreenUpdating = True
   
End Sub


but it does not work.
A help?
Thank you in advance.
max max

I have a working VB script for a Word document but I think it could be cleaned up a bit.

$
0
0
EDIT: Could a mod/admin please move this to the developers forum. I didn't know about it until after I posted this and I feel that it would be more appropriate there. Thank you.

There was a time that I was half decent at this and I'm in the process of re-learning because of some projects my boss has assigned me to....

Anyway, this is basically a form in which you enter your information and the program will automatically format and place the text to be printed on a label sheet. This is done to keep all of the labels uniform and easy to read because some people like to get carried away with artsy fartsy fonts and styles.


Thinking this through as best I could, I wanted something that would be easy for anyone (there are a few fifty-somethings in the dept) to use and worked reliably, so here is the program that I came up with:

  • Each cell contains grayed italicized text which indicates the data that belongs in each box.
  • If data is entered in the box; the font switches to a black non-italicized Arial font.
  • If the data is left blank, the grayed text returns. If the textbox in the lower right contains information entered by the user, a slash will automatically be added before it via a hidden textbox. I tried doing this another way which wasn't working (I'll get to that later) so I had to do it by adding hidden textboxes which are named "TextBox1, TextBox2, etc"
Here is the code for the first 4 textboxes.
Code:

Private Sub txtA1_01_AfterUpdate()
    If txtA1_01 = "" Then
        txtA1_01.Font.Italic = True
        txtA1_01 = "Item ID"
        txtA1_01.ForeColor = &H80000011
    End If
End Sub
Private Sub txtA1_01_Enter()
    If txtA1_01 = "Item ID" Then
        txtA1_01 = ""
        txtA1_01.Font.Italic = False
        txtA1_01.ForeColor = &H80000007
    End If
End Sub
Private Sub txtA2_01_AfterUpdate()
    If txtA2_01 = "" Then
        txtA2_01 = "Customer"
        txtA2_01.Font.Italic = True
        txtA2_01.ForeColor = &H80000011
    End If
End Sub
Private Sub txtA2_01_Enter()
    If txtA2_01 = "Customer" Then
        txtA2_01 = ""
        txtA2_01.Font.Italic = False
        txtA2_01.ForeColor = &H80000007
    End If
End Sub
Private Sub txtA3_01_AfterUpdate()
    If txtA3_01 = "" Then
        txtA3_01.Font.Italic = True
        txtA3_01 = "Customer Part Number"
        txtA3_01.ForeColor = &H80000011
    End If
End Sub
Private Sub txtA3_01_Enter()
    If txtA3_01 = "Customer Part Number" Then
        txtA3_01 = ""
        txtA3_01.Font.Italic = False
        txtA3_01.ForeColor = &H80000007
    End If
End Sub
Private Sub txtA4_01_AfterUpdate()
    If txtA4_01 = "" Then
        txtA4_01.Font.Italic = True
        txtA4_01 = "Description"
        txtA4_01.ForeColor = &H80000011
    End If
End Sub
Private Sub txtA4_01_Enter()
    If txtA4_01 = "Description" Then
        txtA4_01 = ""
        txtA4_01.Font.Italic = False
        txtA4_01.ForeColor = &H80000007

And then the slash via hidden textbox which comes later in the scrpit.
Code:

If txtA4_01.ForeColor = &H80000007 Then
    TextBox1.Value = " / "
    End If
End Sub


The command button in the middle of the form transfers the data to the respective textboxes. The Textboxes that still contain their default values will not transfer.

Here is the code for the command button.

The code that deletes the cells that still contain their default values so they don't transfer.
Code:

Sub cmd01_Click()

    If txtA1_01.ForeColor = &H80000011 Then
    txtA1_01.Value = ""
    End If
    If txtA2_01.ForeColor = &H80000011 Then
    txtA2_01.Value = ""
    End If
    If txtA3_01.ForeColor = &H80000011 Then
    txtA3_01.Value = ""
    End If
    If txtA4_01.ForeColor = &H80000011 Then
    txtA4_01.Value = ""
    End If
    If txtA1_02.ForeColor = &H80000011 Then
    txtA1_02.Value = ""
    End If
    If txtA2_02.ForeColor = &H80000011 Then
    txtA2_02.Value = ""
    End If
    If txtA3_02.ForeColor = &H80000011 Then
    txtA3_02.Value = ""
    End If
    If txtA4_02.ForeColor = &H80000011 Then
    txtA4_02.Value = ""
    End If

And here is the code that transfers the data.

Code:

  Application.ScreenUpdating = False
  With ActiveDocument
      .Bookmarks("txt01a").Range.Text = txtA1_01.Value
      .Bookmarks("txt02a").Range.Text = txtA2_01.Value
      .Bookmarks("txt03a").Range.Text = txtA3_01.Value & " " & TextBox1.Value & txtA4_01.Value
      .Bookmarks("txt01a2").Range.Text = txtA1_02.Value
      .Bookmarks("txt02a2").Range.Text = txtA2_02.Value
      .Bookmarks("txt03a2").Range.Text = txtA3_02.Value & " " & TextBox2.Value & txtA4_02.Value
     
   
  End With


  Unload Me
 
  End Sub



Now even though it is technically working, I think it is somewhat bloated and I know that the more code you write, the more likely you are to have problems in the future. This combined with that fact that I was muddling through gives me low confidence with the integrity of my script.
That being said, here are my concerns:
  • The way I'm adding the slash (based on the lower right textbox) is via a hidden textbox. I feel like there is a better way to do this but adding the hidden textbox was the only way I could make it work.
  • Also my method of data transfer from the textboxes over to the document. I think it would be better to transfer the data when it contains info entered by the use using If/When based on what's in the cell because this would eliminate the need for deletion of untouched textboxes when hitting the Command Button because it would mean less code.
  • Then finally there is one minor flaw that I would like to have fixed if possible. Whenever a space is entered in the textboxes, the defualt values won't return. There literally needs to be nothing in the textbox. This in turn will cause the "/" to transfer to the document if a space has been entered in the lower right textbox.


Now I understand that this is a pretty big form to manage (100 textboxes in all) so I'm doing my best to keep things understandable for you guys.
  • Here is an example of the form as it appears in full view along with an explanation of naming syntax for the non-hidden textboxes (link)
  • Here is an example of how the form transfers data based on the conditions that I described earlier (link)
  • Because there is alot of code in this file, I have attached a smaller version of the form only containing only the top 16 textboxes and the 4 hidden textboxes relating to it which should make it easier to review (hopefully)
  • FWIW, I also attached the full version of the script.
  • There are two zip files. Each one respectively containing the code,, the .frm file, and their respective documents.http://i.imgur.com/HTowkGy.png
  • I know I need to fix the tab order with the textboxes, I'm working on that.
  • I also know that my bookmark naming syntax isn't 100% consistent. This is because I was having problems with them disappearing for no apparent reason and not working unless I gave renamed them. Next time, I'll make sure to establish bookmarks at final step.
I tried to be as informative as I could be. I'm open to all tips and suggestions. Thanks in advance :)

[SOLVED] How to transpose multiple columns and multiple rows in a sheet to another sheet

$
0
0
image1.jpgimage2.jpgimage3.jpgimage4.jpg

dear experts

I would require your help for fixing my issue related to writing a macro to transpose some multiple columns and multipel rows to a summary format in another sheet.
I am attaching all the cases for your immediate response and help.

attached also the excel sheet to work on.

there are three sheets in excelimage1.jpgimage2.jpgimage3.jpgimage4.jpgsmple excel.xlsx

kindly provide me with the right to use macro, because i have been scratching my head for this since last 3 days, and i need to submit it by Sunday,UAE

thanks in advance for the help
regards
MN

move cell value down after value change from rslinx

$
0
0
I am receiving data in cell A1 from a PLC tag through a DDE connection from rslinx server and want to load cell A2 with the value of A1 when the value of A1 changes. Every time the value in A1 changes i need to move the new value down to A2 while moving the value in A2 down to A3 and so on and so forth. I have tried some VBC that will move the values down a cell every time i change the value of A1 but cannot get the code to do this on its own without pressing the enter button so the cell A1 just keeps updating its value without moving the value down to cell A2.
I hope i have explained that clearly

Top ten by vba code

$
0
0
Hello everyone
I have a file that enbales me to extract the top ten for the students who got the highest marks
There is a solution by formulas in the attachment ..I need to get the same results by code
I can select the subject from range("J1") ..

Hope it is clear
Attached Files

code to make single worksheet read only but not lock all cells

$
0
0
I'm using Excel 2007. I have a shared workbook with 31 worksheets, one for each day of the month. The shared workbook is in use 24 hours a day, although it could un-shared and then re-shared if need be for short periods.

Each worksheet is identical, and has both locked and unlocked cells. I want code to run behind a button that would make a worksheet read only but without locking all the cells. The code would include a password. A second button would undo the read only status of the worksheet, returning it to the state it was before the first code was run. Each worksheet would have two buttons. The "Protect" button would make the worksheet read only, the "Unprotect" button would return the worksheet to the exact state before the Protect button was selected. I understand this code may not work while the workbook is shared, but as I said it could be un-shared for a short period.

My purpose here is to prevent users from making changes to a previous days worksheet unless they know the password.

Am I asking for too much?

Copy pasteSpecial Values after rngCopy

$
0
0
I am trying to add the PasteSpecial xlPasteValues or .value command after the blue font command but I keep getting an error
Can you help please


Code:

Sub CopyRangeTEST5()


    Dim rngCCopy As Range, StartRow As Long, LastRow As Long, r As Long
   
    Set rngCCopy = Sheets("MONITOR").Range("A6", Sheets("MONITOR").Range("F" & Rows.Count).End(xlUp))

   
    StartRow = Range("J:J").Find("ACTUAL", , , 1, 1, 2, 0).Row + 1
    LastRow = Range("Q" & Rows.Count).End(xlUp).Row
   
  For r = StartRow To LastRow Step rngCCopy.Rows.Count
   
        rngCCopy.Copy _
        Destination:=Range("K" & r)

       
   
    Next r
 
End Sub

Write VBA Code/Macro for this question.

$
0
0
You have some data values typed on column A starting from cell A1. You have to create a macro that cumulatively sums the last ‘n’ values provided in column A starting from current row and write the result in corresponding cell of column B. For example, if n=5, then in cell B5 you have to provide sum of values from cell A1 to A5. Similarly in cell B7, the sub should write the sum of values from cell A3 to A7. Essentially the macro shall be providing the sum in cell B5 onwards to include all last ‘n’ values in column A. Unless the number is Column A is ‘5’, in that case, ignore it and do not add it to the sum. Take the input of ‘n’ from the user and make a ‘button’ to launch the macro.
Please refer to the tab “sum” in the file “Final.xlsx”final.xlsx

VB MACRO for Multiple Pivot Table

$
0
0
Dear Experts ,

Can anyone explain me to write macro with looping to create multiple Pivot table in different tabs from one pivot source. I have attached excel files and insert two pivot tables as I required.
I have variable from X1 to X33 in my rows and I need pivot table Name in Row label, Time in Colum label and X1 in Values Field (value filed must be summarized as Sum)
I need 33 Pivot tables in different tabs while keeping constant Row label and Colum label as name and time , and changing value field (value filed must be summarized as Sum) from X1 to X33.

I have inserted two pivot table for get it clear my requirement.

Thanks and Regards.

NNNN
Attached Files

[SOLVED] cut and paste (re ask)

[SOLVED] copy and change no of parcels every time copy

$
0
0
I have one label range A1:G17 needs to copy number of times according K2 value and change C6 Value in each label which is green according to K1 value .please help me check my attachment
Attached Files

What is a com add in

$
0
0
What is a com add in vs. a regular add in?

Speed Up the List Box Loop

$
0
0
Hi Experts

I created Three List Boxes and make depending loop to insert data on different sheets.
This works well but doing very slow.

Please help me to make it fast.

I shall be very thankful to you.
Code:

Dim sName As String
Dim tHead As String
Dim tRem As String
Dim Er As Long


    For j = 0 To ListBox3.ListCount - 1
        sName = Val(j) + 1
        Set Ws = Sheets(sName)
        tHead = ListBox3.Column(0, j)
        tRem = ListBox3.Column(1, j)
        'MsgBox tHead
        'MsgBox tRem
        Ws.Range("A1").Value = tHead
        Ws.Range("K1").Value = tRem
       
            With ListBox2
            For i = 0 to .ListCount - 1
                    If .Column(0, i) = tHead Then
                    Er = WorksheetFunction.CountA(Ws.Range("A:A")) + 1
                        If .Column(6, i) = "Heading" Then
                            Ws.Cells(Er, "A").Value = .Column(1, i)
                            Ws.Cells(Er, "B").Value = .Column(2, i)
                            Ws.Cells(Er, "C").Value = .Column(3, i)
                            Ws.Cells(Er, "D").Value = .Column(4, i)
                            Ws.Cells(Er, "E").Value = .Column(5, i)
                            Ws.Cells(Er, "F").Value = .Column(6, i)
                        Else
                            If Len(.Column(2, i)) > 0 Then
                                Ws.Cells(Er, "A").Value = .Column(1, i)
                                Ws.Cells(Er, "B").Value = .Column(2, i)
                                Ws.Cells(Er, "C").Value = .Column(3, i)
                                Ws.Cells(Er, "D").Value = .Column(4, i)
                                Ws.Cells(Er, "E").Value = .Column(5, i)
                                Ws.Cells(Er, "F").Value = .Column(6, i)
                            End If
                        End If
                    End If
            Next i
            End With
    Next j



For j = 0 To ListBox4.ListCount - 1
        sName = ListBox4.Column(0, j)
        Set Ws = Sheets(sName)
        tHead = ListBox4.Column(0, j)
        tRem = ListBox4.Column(1, j)
        'MsgBox tHead
        'MsgBox tRem
        Ws.Select
        'Ws.Range("A1").Value = tHead
        Ws.Range("A46").Value = tRem
       
            With ListBox2
            For i = 0 to .ListCount - 1
                    If .Column(0, i) = tHead Then
                    Er = WorksheetFunction.CountA(Ws.Range("F:F")) + 1
                        If .Column(6, i) = "Heading" Then
                            Ws.Cells(Er, "A").Value = .Column(1, i)
                            Ws.Cells(Er, "B").Value = .Column(2, i)
                            Ws.Cells(Er, "C").Value = .Column(3, i)
                            Ws.Cells(Er, "D").Value = .Column(4, i)
                            Ws.Cells(Er, "E").Value = .Column(5, i)
                            Ws.Cells(Er, "F").Value = .Column(6, i)
                        Else
                            If Len(.Column(2, i)) > 0 Then
                                Ws.Cells(Er, "A").Value = .Column(1, i)
                                Ws.Cells(Er, "B").Value = .Column(2, i)
                                Ws.Cells(Er, "C").Value = .Column(3, i)
                                Ws.Cells(Er, "D").Value = .Column(4, i)
                                Ws.Cells(Er, "E").Value = .Column(5, i)
                                Ws.Cells(Er, "F").Value = .Column(6, i)
                            End If
                        End If
                    End If
            Next i
            End With
    Next j

Screen Updating and Calculation Setting I have tried but still failed to speed up this.

Thanks
Amir
Viewing all 50207 articles
Browse latest View live