Posts by Eggcel

Eggcel · Nov 28th 2011

Re: Simple VBA loop help

try this

Code

Sub RecordLoop()
    
     Dim a, b()
     Dim i As Integer, x As Integer
     Dim lrow As Long
   'write the values of column D to array a
   lrow = Sheets("Input").Cells(Rows.Count, "D").End(xlUp).Row
   a = Sheets("Input").Range("D1:D" & lrow).Value
   'set b to equal size of a
   ReDim b(1 To UBound(a, 1), 1 To 1)
   'loop through a from end to beginning and write values to b
   For i = UBound(a, 1) To LBound(a, 1) Step -1
       x = x + 1
       b(x, 1) = "Q" & a(i, 1)
   Next
  'Writes the values of b to Post-processing sheet modify _
  the column and/or row number to suit your needs
   With Sheets("Post-processing").Cells(1, 1).Resize(UBound(b))
    .ClearContents
    .Value = b
   End With
     
End Sub

Display More

Eggcel · Nov 28th 2011

Re: Simple VBA loop help

Can you provide a sheet of sample data and a sheet with the expected result? Also, if you post the code that you have tried, someone could offer you pointers on how to amend it.

Eggcel · Nov 28th 2011

Re: How to fetch the table from ASP web site and save in Excel

Try something like this.

Code

Option Explicit
Sub Button1_Click()
     
    Dim IeTbl As Object
    Dim obj As Object
    Dim Scrn As String
    Dim objIE As SHDocVw.InternetExplorer 'microsoft internet controls (shdocvw.dll)
    Dim htmlDoc As MSHTML.HTMLDocument 'Microsoft HTML Object Library
    Dim htmlInput As MSHTML.HTMLInputElement
    Dim htmlColl As MSHTML.IHTMLElementCollection
    Dim i As Integer, j As Integer, n As Integer
    
    Set objIE = New SHDocVw.InternetExplorer
    If (objIE Is Nothing) Then
        MsgBox "Could not create the Internet Explorer object.  Stopping macro playback."
        Stop
    End If
     
    With objIE
        .Navigate "[URL]http://devts296:81/spiqatools/ui/PolicyFinder.aspx[/URL]" ' Main page
        .Visible = 1
        Do While .ReadyState <> 4: DoEvents: Loop
            Application.Wait (Now + TimeValue("0:00:02"))
            Set htmlDoc = .Document
             
            objIE.Document.getElementById("LOBList").Value = "A"
            objIE.Document.getElementById("DataFilterEnv").Value = "L"
            objIE.Document.getElementById("ctl04_rdbAutoTransitionSignal_1").Checked = True
            objIE.Document.getElementById("ctl04_AutoTransitionSignal").Value = "L"
            objIE.Document.getElementById("btnsubmit").Click
            While objIE.Busy
                DoEvents
            Wend
            While objIE.ReadyState <> 4
                DoEvents
            Wend
        End With
    Set IeTbl = objIE.Document.getelementsbytagname("Table").Item(12)
     For n = 0 To IeTbl.Rows.Length - 1
            For j = 0 To IeTbl.Rows(n).Cells.Length - 1
              If j = 2 Then
                i = i + 1
                Sheet1.Cells(i, 1).Value = IeTbl.Rows(n).Cells(j).innertext 'change sheet and cell destination per your requirements
              End If
            Next j
        Next n
End Sub

Display More

This is untested but should do what you want based on your description.

Eggcel · Nov 25th 2011

Re: List spicific worksheets and rename based on adjacent cell

It's not as simple. That loop is just checking the user input names against each worksheet name then it is looping to create the sheets. Try this instead:

Code

Sub This()
    Dim cell As Object
    Dim i As Integer, y As Integer
    Dim rng As Range
    Dim ws As Worksheet
    Dim Skip As Boolean
    
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Sheets("Sheet1a").Visible = True
    Sheets("Sheet1b").Visible = True
    With Sheets(1)
        Set rng = .Range("B4:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    End With
    i = 4
    For Each cell In rng
        If Application.WorksheetFunction.CountIf(Sheets(1).Range("B4:B" & i), cell) > 1 Then
            GoTo nextcell
        End If
        For Each ws In Application.Worksheets
            If UCase(cell) = Left(UCase(ws.Name), Len(cell)) Then
                Skip = True
                Exit For
            End If
        Next
          If Not Skip = True Then
        Sheets("Sheet1a").Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = cell & "RBAC Role"
        End With
        Sheets("Sheet1b").Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = cell & " Medway Copy"
        End With
          End If
          Skip = False
nextcell:
     i = i + 1
    Next
    Sheets("Sheet1a").Visible = False
    Sheets("Sheet1b").Visible = False
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Display More

If there is a duplicate entry by the user or if a sheetname already exists it will be skipped with no prompt to the user.

Eggcel · Nov 25th 2011

Re: Automatically enter log on information on a webpage via VBA

Use something like this

Code

Option Explicit
Sub this()


Dim IE As Object


Set IE = CreateObject("InternetExplorer.application")
IE.Navigate ("[URL]https://apprenticeshipvacancymatchingservice.lsc.gov.uk/navms/forms/candidate/CandidatesLogin.aspx[/URL]")
IE.Visible = True


  While IE.busy
  DoEvents
Wend
IE.document.getelementbyid("ctl00_ContentBody_LoginControl1_UsernameTextBox").Value = 'your username here
IE.document.getelementbyid("ctl00_ContentBody_LoginControl1_PasswordTextBox").Value = 'your password here
IE.document.all("ctl00$ContentBody$LoginControl1$LoginButton").Click 'click the login button
While IE.busy
  DoEvents
Wend
'any more code
'if the user closes the web page then you don't need the quit
IE.Quit
'set IE to nothing at the end of macro
Set IE = Nothing
End Sub

Display More

Eggcel · Nov 25th 2011

Re: List spicific worksheets and rename based on adjacent cell

Code

Sub This()
    Dim cell As Object
    Dim i As Integer, y As Integer
    Dim rng As Range
    Dim ws As Worksheet
    Dim rcell As Object
    
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With
     
    With Sheets(1)
        Set rng = .Range("B4:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    End With
  
    For Each cell In rng
        If Application.WorksheetFunction.CountIf(rng, cell) > 1 Then
          MsgBox ("Cannot use duplicate Sheet Names")
          Exit Sub
        End If
        For Each ws In Application.Worksheets
            If UCase(cell) = Left(UCase(ws.Name), Len(cell)) Then
                MsgBox ("One or more sheet names already exists.")
                Exit Sub
            End If
        Next
    Next
     Sheets("Sheet1a").Visible = True
     Sheets("Sheet1b").Visible = True
    i = 4
    For y = i To i + rng.Count - 1
    Sheets("Sheet1a").Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = Sheets(1).Range("B" & y) & "RBAC Role"
    End With
    Sheets("Sheet1b").Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = Sheets(1).Range("B" & y) & " Medway Copy"
    End With
    Next
     Sheets("Sheet1a").Visible = False
     Sheets("Sheet1b").Visible = False
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Display More

Eggcel · Nov 23rd 2011

Re: List spicific worksheets and rename based on adjacent cell

change

Code

For y = i To i + rng.Count - 1 Step 2

to just

Code

For y = i To i + rng.Count - 1

if you want the suffix for each sheet. The step 2 means it counts by 2.

Eggcel · Nov 23rd 2011

Re: List spicific worksheets and rename based on adjacent cell

forum.ozgrid.com/index.php?attachment/42388/It is due to the sheet numbers in your workbook. When I tested it, I had SHEET1-3. In your workbook you have Sheet12,3 & 4. I have made the proper modifications and added the check for duplicate sheetnames in the user defined list.

Eggcel · Nov 23rd 2011

Re: using VBA to open links in internet explorer

See if this gives you any joy.

Code

ThisWorkbook.FollowHyperlink Address:= link

Eggcel · Nov 22nd 2011

Re: ColorIndex Function - But COUNT Conditionally Formatted Colors

Use a helper column with the same formula as the conditional formula and then countif the ones that have a TRUE value. You can hide this column if you would rather not see it.

Eggcel · Nov 22nd 2011

Re: Send array argument to javascript function via Excel VBA

You can set up a simple loop to see if you are dealing with frames

Code

Dim myHTMLDoc As HTMLDocument
Dim myHTMLFrame As HTMLDocument
'get the main HTML Document
 Set myHTMLDoc = IE.Document
 ' loop through frames
For i = 1 To myHTMLDoc.frames
Set myHTMLFrame = myHTMLDoc.frames(i).Document
Next

You have to set a reference to microsoft html object library. From what I have read, using frames is not as common anymore. If there is nothing to loop through, you will know you don't have multiple frames. The function has to be called from the parentwindow of the appropriate frame. If you do have frames, you could pull the innerhtml from each one and scan it for clues.

Eggcel · Nov 22nd 2011

Re: Automatically enter log on information on a webpage via VBA

I am getting a server error at that web address. It is possible to do this with VBA if you view the source code for the page. You have to be able to find the right tags to write the values to and to submit. Do you have a working link?

Eggcel · Nov 22nd 2011

Re: List spicific worksheets and rename based on adjacent cell

See if this does what you want.

Code

Sub This()
    Dim cell As Object
    Dim i As Integer, y As Integer
    Dim rng As Range
    Dim ws As Worksheet
    
    With Application
     .DisplayAlerts = False
     .EnableEvents = False
     .ScreenUpdating = False
    End With
    
    With Sheets(1)
      Set rng = .Range("B4:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    End With
    If InStr(rng.Count / 2, ".") > 0 Then
     MsgBox ("Must be an even number of Sheet Names.")
     Exit Sub
    End If
    For Each cell In rng
      For Each ws In Application.Worksheets
        If UCase(cell) = UCase(ws.Name) Then
          MsgBox ("One or more sheet names already exists.")
          Exit Sub
        End If
      Next
    Next
    i = 4
    For y = i To i + rng.Count - 1 Step 2
      Sheets("Sheet1a").Copy After:=Sheets(Sheets.Count)
       With Sheets(Sheets.Count)
       .Visible = True
       .Name = Sheets(1).Range("B" & y)
       End With
      Sheets("Sheet1b").Copy After:=Sheets(Sheets.Count)
       With Sheets(Sheets.Count)
        .Visible = True
        .Name = Sheets(1).Range("B" & y + 1)
       End With
    Next
    
     With Application
     .DisplayAlerts = True
     .EnableEvents = True
     .ScreenUpdating = True
    End With
End Sub

Display More

Eggcel · Nov 21st 2011

Re: Send array argument to javascript function via Excel VBA

Does the page employ frames at all? If so, some of the code could be in another frame. Also, do you have to navigate through a couple of pages to get to this point? If that is the case then there may be more info on a prior page. Have you tried different variations in your function call listing the items individually separated by commas, or tried one at a time?

Eggcel · Nov 21st 2011

Re: Send array argument to javascript function via Excel VBA

I wish I could be more help. If I could pick through the source code I might be able to figure something out. I have automated several web pages, but some of it is trial and error with bits of the source code. If you can manually select something on the page, then there is somewhere in the source code that references that. As for hidden tags, they are visible in the source code, they are just named hidden. I have run into drop down lists that use them, and multiple items are written to them as an array separated by commas. Let us know how you are getting on. Feel free to ask further questions and I will try to answer.

Edit: I just saw your latest revision to your post. Something you might try is to manually make your selection and then write the value of levelldxarray to a string and then you might be able to see how the value is supposed to be listed when you call the function. Is LevelIdxarray listed elsewhere in the source code?

Eggcel · Nov 21st 2011

Re: List spicific worksheets and rename based on adjacent cell

Go with

Code

Sub Nchange()
    Dim cell As Object
    Dim i As Integer
    i = 4
    For Each cell In Sheets(1).Range("A4:A" & Cells(Rows.Count, "A").End(xlUp).Row)
      If cell.Offset(, 1) <> "" Then
        Select Case cell
        
            Case Is <> cell.Offset(, 1)
              On Error Resume Next
              Sheets(i).Name = cell.Offset(, 1)
              If Err > 0 Then
                MsgBox ("Sheet name " & cell.Offset(, 1) & " already exists or is invalid.")
              End If
        Case Else
             
        End Select
     End If
        i = i + 1
    Next
End Sub

Display More

I also changed it so it will ignore blank cells in B.

Eggcel · Nov 21st 2011

Re: List spicific worksheets and rename based on adjacent cell

Try this.

Code

Option Explicit
Sub SheetN()
Dim ws As Worksheet
Dim i As Integer
i = 4
For Each ws In Application.Worksheets
  If ws.Index > 3 Then
   Sheets(1).Range("A" & i) = ws.Name
   i = i + 1
  End If
Next
End Sub
Sub Nchange()
Dim cell As Object
Dim i As Integer
i = 4
For Each cell In Sheets(1).Range("A4:A" & Cells(Rows.Count, "A").End(xlUp).Row)
   Select Case cell
   
   Case Is <> cell.Offset(, 1)
     Sheets(i).Name = cell.Offset(, 1)
   Case Else
   
   End Select
   i = i + 1
Next

Display More

Eggcel · Nov 19th 2011

Re: Macro returning formula instead of value

Quote

but unfortunately I can only get it to return a formula and not a blank cell with the formula in the background.

Can you explain this a bit more please. When I tested your first bit of code, it put the formula in the required cells.

Eggcel · Nov 19th 2011

Re: Send array argument to javascript function via Excel VBA

Is there somewhere else in your innerhtml source code that references the function you are trying to call? There may be an onclick event that fires the function.
This may be key to your array values. I would guess that those are hidden tags that get their values by some input on the web page. It has been my limited experience that when automating web pages with a drop down list with multiple values, these values are written to the hidden tags for use when the function fires. Let me know if this gets you any further and I will try to help you more.

Eggcel · Nov 19th 2011

Re: Capture values from active IE page

Try this

Code

Option Explicit
Sub Ebay()


Dim shellwin As ShellWindows
Dim IE As SHDocVw.InternetExplorer
Dim I As Integer, y As Integer
Dim Price As String, Member As String
Set shellwin = New SHDocVw.ShellWindows
For I = 1 To shellwin.Count
  Set IE = shellwin.Item(I)
    If Not IE Is Nothing Then
            If InStr(1, IE.LocationURL, "file://", vbTextCompare) = 0 And Len(IE.LocationURL) <> 0 Then _
            Exit For
    End If
Next
If I = shellwin.Count + 1 Then
  MsgBox ("No Open IE window found")
End If
On Error Resume Next
Price = IE.Document.getelementbyid("v4-27").innertext
    If InStr(Price, "$") > 0 And Not Price = "" Then
      ActiveCell.Offset(, 1) = Price
      For y = 1 To IE.Document.getelementsbytagname("a").Length
       Member = IE.Document.getelementsbytagname("a").Item(y).Title
        If InStr(Member, "Member") > 0 Then
         Member = Right(Member, Len(Member) - 10)
         ActiveCell.Offset(, 2) = Member
         Exit For
         Else
           Member = ""
        End If
      Next
      If Member = "" Then MsgBox ("Member ID not found")
    Else
      MsgBox ("Price not found")
    End If
    Set IE = Nothing
    Set shellwin = Nothing
End Sub

Display More

This will set the IE object to the open IE window. This will only work if it is the only IE window and tab open.