Posts by Gizzmo

Gizzmo · Dec 1st 2020

I am trying to automate the 'Search' box on the following website "https://www.blackwoods.com.au". I have tried to modify original source code from "xl-searchbot.xlsm" from http://automatetheweb.net/", but having no luck in actually getting the 'Search' box to be populated. My understanding of the html and DOM structure is limited and I have being trying for the last 2 days with no luck.

Code

'Original source code from "http://automatetheweb.net/" xl-searchbot.xlsm

Sub ScrapeBlackwoods()
 
    Dim objIE As InternetExplorer 'special object variable representing the IE browser
    Dim aEle As Object 'HTMLLinkElement 'special object variable for an <a> (link) element
 
    'initiating a new instance of Internet Explorer and asigning it to objIE
    Set objIE = New InternetExplorer
 
    'make IE browser visible (False would allow IE to run in the background)
    objIE.Visible = True
 
    'navigate IE to this web page
    objIE.Navigate "https://www.blackwoods.com.au" '"search/?text=12345"
 
    'wait here a few seconds while the browser is busy
    Do While objIE.Busy = True Or objIE.ReadyState <> 4: DoEvents: Loop
    
    Set aEle = objIE.Document.getElementsByClassName("searchProducts")(0)

    'Print to see what is being set and if I am on the right track
    Debug.Print aEle.ClassName
    Debug.Print aEle.TagName
    Debug.Print aEle.ID
    'Debug.Print aEle.href
    Debug.Print aEle.innerText
    Debug.Print aEle.innerHTML
    Debug.Print aEle.outerHTML
    
'in the search box put a value that represents the suppliers product code which eventually will be listed on sheet 1
'for now just enter 12345 as a test
 Call aEle.SetAttribute("value", "123456")

    Do While objIE.Busy = True Or objIE.ReadyState <> 4: DoEvents: Loop
 
    'close the browser
    objIE.Quit
 
'exit our SearchBot subroutine
End Sub

Display More

This is the HTML Extract for what I believe is the particular area of the DOM that I need to interact with.

Code

<form name="search_form_SearchBox" class="searchProducts" action="/search/" method="get">
        
        
        <div class="input-group">
            <input name="text" class="form-control js-site-search-input searchProductsheader ui-autocomplete-input" role="search" aria-haspopup="true" type="text" maxlength="100" placeholder="Search Products / Category / Brand" value="" data-options='{"autocompleteUrl" : "/search/autocomplete/SearchBox","minCharactersBeforeRequest" : "2","waitTimeBeforeRequest" : "400","displayProductImages" : true}' autocomplete="off">
            <span class="input-group-btn"> <button class="clear-icon-search fa fa-close" type="button"></button>
                    <button class="btn btn-link js_search_button" onclick="SearchResultRedirect1()" type="button" data-rippleria="">
                            <i class="bw-icon icon-search"></i><span class="header_search_button_text">Search</span>
                    </button>
                </span>
        </div>
    </form>

Display More

I would aApprecaite any help or advise.

Gizzmo · Sep 20th 2019

Hi JimmyB,

I'm guess that it has something to do with the "Dim" statements and the associated "Set" statements.

Try amending

Code

Dim RngA as Double
Dim FirstCell as Range 'or as Double
Dim LastCell as Range 'or as Double

Note the above Dim as statements will depend on what type of object you are trying to dimension (i.e. define) and subsequently set in the Set Statements

Set FirstCell = RngA.Offset(-600, -3) what is that you want here (i.e. Cell Address, Row Number etc.).

I am not a VB expert so hopefully this makes sense and helps you.

If you attach a copy of the workbook, it would also help.

As an alternative or look at the attached file which I based on code from [URL="http://Range(FirstCell,%20LastCell).Delete%20Shift:=xlUp"]stackoverflow [/URL]and my interpretation of the comments in your code.

Regards,

Gizzmo

Gizzmo · Sep 20th 2019

Hi Trebor76,

Quote

What was wrong with my solution here?

If you must cross-post please provide a link to each other site as I have done with the above link.

My apologies, I was not aware the OP was a cross-post and that you had already provided a solution.

Regards,

Gizzmo

Gizzmo · Sep 19th 2019

Hi crysp711,

Try this code, modify as required the SourceFolderName ?????? and Range (" ") = Array portion.

Code

Sub ListFilesinFolder()


    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim rRng As Range


    'SourceFolderName = "C:\Users\???????\Desktop\OzGrid\"


    Set FSO = New Scripting.FileSystemObject
    'Set SourceFolder = FSO.GetFolder(SourceFolderName)


    Range("A1:C1") = Array("text file", "path", "Date Last Modified")


    Set rRng = Sheet1.Range("D1:D7")


    For Each rcell In rRng.Cells
   
    If IsEmpty(rcell) Then
   


    Else
   
        Set SourceFolder = FSO.GetFolder(rcell)
   
        i = 2
        For Each FileItem In SourceFolder.Files
       
            If CDate(DateValue(FileItem.DateLastModified)) = DateValue(Now()) And FileItem Like "*.pdf*" Then
           
                Cells(i, 1) = FileItem.Name
                Cells(i, 2) = FileItem
                Cells(i, 3) = FileItem.DateLastModified
               
                i = i + 1
     
            Else
   
            End If
       
        Next FileItem
   
    End If


    Next rcell


    Set FSO = Nothing


End Sub

Display More

Note credit for the majority of this code comes from Santosh I have just modified where required to meet modified today and file is pdf.

Gizzmo

Gizzmo · Sep 18th 2019

Ok if that's the case, and this is messy, only because I am no expert, but try this code instead, hopefully it will cater for row and column sizes being different between workbooks

Code

Sub CopyRange()
 Application.ScreenUpdating = False
 Dim wkbDest As Workbook
 Dim wkbSource As Workbook
 Set wkbDest = ThisWorkbook
 Dim LastRow As Long
 Const strPath As String = "C:\Users\cmarsh\Desktop\group_1\"
 ChDir strPath
 strExtension = Dir("*.xls*")
 Do While strExtension <> ""
 Set wkbSource = Workbooks.Open(strPath & strExtension)
 
 Application.ScreenUpdating = True
 
 With wkbSource
 LastRow = .Sheets("Appendix B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
Dim rLastCell As Range


Dim rwkbSourceLastCell As Range


Set rLastCell = wkbDest.Sheets("Master").Cells.Find(What:="*", After:=wkbDest.Sheets("Master").Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)




 If rLastCell Is Nothing Then Set rLastCell = wkbDest.Sheets("Master").Cells(1, 1)
 
 wkbDest.Sheets("Master").Cells(2, rLastCell.Column).Offset(-1, 1).Value = wkbSource.Name
 
 
 Set rwkbSourceLastCell = .Sheets("Appendix B").Cells.Find(What:="*", After:=.Sheets("Appendix B").Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
 xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
 
 
 wkbDest.Sheets("Master").Cells(2, rLastCell.Column + 1).Resize(LastRow, rwkbSourceLastCell.Column).Value = .Sheets("Appendix B").Cells(1, 1).Resize(LastRow, rwkbSourceLastCell.Column).Value
 
 .Close savechanges:=False
 
 End With
 strExtension = Dir
 Loop
 Application.ScreenUpdating = True




End Sub

Display More

Gizzmo

Gizzmo · Sep 18th 2019

Change

Code

.Sheets("Appendix B").Range("A1:D" & LastRow).Copy wkbDest.Sheets("Master").Cells(2, rLastCell.Column + 1)

To

Code

wkbDest.Sheets("Master").Cells(2, rLastCell.Column + 1).Resize(LastRow, 4).Value = .Sheets("Appendix B").Range("A1:D" & LastRow).Value

Please note I am assuming your data is always going to be 4 Columns wide...hence "Resize(LastRow,4)" in the code snippet above.

Gizzmo · Sep 18th 2019

Your welcome, glad I could help.

Gizzmo · Sep 18th 2019

Hi Claire,

Try changing

Code

Const strPath As String = "C:\Users\cmarsh\Desktop\group_1"

To

Code

Const strPath As String = "C:\Users\cmarsh\Desktop\group_1\"

Also see my edit to my original reply as I changed the code to allow for workbook name.

Gizzmo

Gizzmo · Sep 18th 2019

Hi Claire,

Try this

Code

Sub CopyRange()
 Application.ScreenUpdating = False
 Dim wkbDest As Workbook
 Dim wkbSource As Workbook
 Set wkbDest = ThisWorkbook
 Dim LastRow As Long
 Const strPath As String = "C:\Users\cmarsh\Desktop\group_1\"
 ChDir strPath
 strExtension = Dir("*.xls*")
 Do While strExtension <> ""
 Set wkbSource = Workbooks.Open(strPath & strExtension)
 With wkbSource
 LastRow = .Sheets("Appendix B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
 
Dim rLastCell As Range


Set rLastCell = wkbDest.Sheets("Master").Cells.Find(What:="*", After:=wkbDest.Sheets("Master").Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
 
 If rLastCell Is Nothing Then Set rLastCell = wkbDest.Sheets("Master").Cells(1, 1)
 
 wkbDest.Sheets("Master").Cells(2, rLastCell.Column).Offset(-1, 1).Value = wkbSource.Name
 
 .Sheets("Appendix B").Range("A1:D" & LastRow).Copy wkbDest.Sheets("Master").Cells(2, rLastCell.Column + 1) '.End(xlUp).Offset(1, 0)
 .Close savechanges:=False
 
 End With
 strExtension = Dir
 Loop
 Application.ScreenUpdating = True
End Sub

Display More

Gizzmo

Gizzmo · Jun 7th 2019

Hi Peter,

Yes helper column/cell is needed with the formula provided by NBVC

As an Example in cell C2 just put "=YEAR(DATE("20"&LEFT(B2,2),MID(B2,3,2),RIGHT(B2,2)))"

Change the format to General for cell C2. Result should be "2019". Your original post referring to "=year (B2)" has been interpreted by me as return the year only which is 2019, in a separate cell.

From your response to NBVC, it appears you are wanting to come up with custom format on cell B2 in the first instance to display "2019-06-05"

If this is the case then go to Format Cells, Custom and enter 20##-##-##. But please realise that excel will not recognise this as a date!

Hope this helps.

Regards,

Gizzmo

Gizzmo · Jun 6th 2019

Quote from excel.lelkes
Hi!
Let me explain:
in cell B2 i enter 190605 and i want it to show as 19-06-05
I made it through custom formatting
Code
## - ## - ##
But excel (office 365) does not recognize it as date because the value of B2 is 190605.
How can I solve this so I can use B2 for
Code
=year (B2)
Thanks in advance
Regards
Peter from Sweden
Display More

Hi Peter,

Which part of your value in B2 represents Year, Month and Day?

Is the year 2019, the month 06 and the day 05; or
is the year 2005, the month 06 and the day 19

Regards,

Gizzmo

Gizzmo · Sep 26th 2014

Re: Using a selection from a list to poulate adjoining cells

Hello cojak,

Welcome to Ozgrid.

Quick and simple solution using vlookup (NB the iferror then blank) and protection on sheet.

You may also find the following link useful. http://www.contextures.com/xlDataVal08.html

Gizzmo · Sep 26th 2014

Re: A Total Count of All Records based on a Specific Year (i.e., 2014 or 2012) in Exc

Amended file with 2 possible solutions (thanks to pivot as per royUK, amended formula as per MrRedli) and combination of dynamic names, helper column for year and data validation linked to unique list based on pivots.

Hopefully Lamzie finds replies helpful.

Gizzmo · Sep 26th 2014

Re: A Total Count of All Records based on a Specific Year (i.e., 2014 or 2012) in Exc

Quote from MrRedli;727452

you can do the same thing without the helper column:

=COUNTIFS(CourseTitle,"Mindfulness-Based Stress Reduction - Alumni Group",QtrOfYrRN,"4th Quarter",DateRN,">"&DATE(B2,1,1),DateRN,"<="&DATE(B2,12,31))

Sweet, thanks for the improvement on my post

Gizzmo

Gizzmo · Sep 26th 2014

Re: A Total Count of All Records based on a Specific Year (i.e., 2014 or 2012) in Exc

See the attached file. I have had to use a 'helper' column for Year and named this range DateRN, hope it helps.

Gizzmo · Sep 25th 2014

Re: New to Macros, Need help

Hi Max,

Refer to attached file for example of Button and User Form to Filter by Headquarters and Platoon.

Is this the type of thing you are looking for?

Cheers,

Gizzmo

Gizzmo · Sep 25th 2014

Re: New to Macros, Need help

Hi royUK,

Agreed, but from the orginal post

Quote

.... It is difficult for me to send the document to people and explain to them how to filter out only their platoon, or filter just vehicles.... I want to make a button at the top of the document, that when clicked, will show specific information from the spreadsheet. The same way as if I filtered out specific text under columbs.

I get the impression that Max wants something other than this (i.e. Not have to explain to them how to use AutoFilter).

Regards,
Gizzmo

Gizzmo · Sep 25th 2014

Re: Prevent returning value on a blank cell (=IF, True/False)

Try =IF(I26=0,"",IF(I26>NOW(),"Good","Not Good"))

Gizzmo · Sep 25th 2014

Re: New to Macros, Need help

Hi Max,

And welcome to Ozgrid.

Your tittle "New to Macros, Need Help" whilst I appreciate your intention its not the best place to put this comment, only because the tittle is used by Forum users to search on key words that they can then either help and or use. Perhaps a better tittle would be "Button to filter data".

If you can attach a sample of your data (if its not sensitive, or even a dummy sample) I may be able to help or provide suggestions.

Regards,

Gizzmo

Gizzmo · Sep 25th 2014

Re: Project Plan with Gantt Chart and Resources Management

Quote from Gorgey;727224

Is there any other trick that could be consider to speed up the update?

This is probably not the best solution but try amending Worksheet_Change to...

Code

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim myValue As String
    Dim myAddress As Range
    Dim rng As Range
    Dim r As Range
    Dim Lastrow As Long
    Dim Lastcol As Long
    Dim myRow As String
    Dim ColLtr As String
    
    If Not Intersect(Target, Range("Responsible_TargetRange")) Is Nothing Then
    myValue = Target.Address


        If Target.Address = "$B$1" Then
        
        Call UpDateGantt
        
        Else
    
            Range(Target.Address).Interior.Color = Range("Responsible_List").Find(What:=Target, LookAt:=xlWhole).Interior.Color
        
            myRow = Range(Target.Address).Row 'Range(Target.Address).End(xlToLeft).Address(False, False)
        
            ColLtr = Replace(Range("XFD3").End(xlToLeft).Address(False, False), 3, "")
        
            Lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
            Lastcol = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
        
            Set rng = Sheets("Sheet1 (2)").Range("K" & myRow & ":" & ColLtr & myRow)
        
            'rng.Select
        
            For Each r In rng
        
            Dim StartDate As Date
            Dim EndDate As Date
            Dim PlanDate As Date
            Dim CurrentDate As Date
            Dim myPerson As String
        
            StartDate = Range("I" & Range(r.Address).Row).Value
            EndDate = Range("J" & Range(r.Address).Row).Value
            ColLtr = Replace(Range(r.Address).Address(False, False), Range(r.Address).Row, "")
            PlanDate = Range(ColLtr & 3).Value
            myPerson = Left(Range("B" & Range(r.Address).Row).Value, 1)
        
            If PlanDate >= StartDate And PlanDate <= EndDate Then
        
            r.Value = myPerson
            r.NumberFormat = "General"
            r.Interior.Color = Range("B" & Range(r.Address).Row).Interior.Color
        
                If PlanDate = Range("Date_Current").Value Then
                    Range(ColLtr & 3).Offset(0, -1).Interior.ColorIndex = xlColorIndexNone
                    Range(ColLtr & 3).Offset(0, 1).Interior.ColorIndex = xlColorIndexNone
                    Range(ColLtr & 3).Interior.Color = Range("Date_Current").Interior.Color
                    r.Interior.Color = Range("Date_Current").Interior.Color
                    Else
                        'Range(ColLtr & 3).Interior.ColorIndex = xlColorIndexNone
                End If
        
                Else
                r.Value = ""
                r.NumberFormat = "General"
                r.Interior.ColorIndex = xlColorIndexNone
        
                    If PlanDate = Range("Date_Current").Value Then
                    Range(ColLtr & 3).Offset(0, -1).Interior.ColorIndex = xlColorIndexNone
                    Range(ColLtr & 3).Offset(0, 1).Interior.ColorIndex = xlColorIndexNone
                    Range(ColLtr & 3).Interior.Color = Range("Date_Current").Interior.Color
                    r.Interior.Color = Range("Date_Current").Interior.Color
                    Else
                        'Range(ColLtr & 3).Interior.ColorIndex = xlColorIndexNone
                    End If
        
            End If
        
            Next r


        End If
    End If
End Sub

Display More

This will only change/update the row in which the 'Responsible' resource has been changed.

Howver if the Current Date is changed it will still Call the UpDateGantt macro so that the Current Date is highlighted correctly

Code

Sub UpDateGantt()




    'Get current state of various Excel settings


    screenUpdateState = Application.ScreenUpdating


    statusBarState = Application.DisplayStatusBar


    calcState = Application.Calculation


    eventsState = Application.EnableEvents


    displayPageBreakState = ActiveSheet.DisplayPageBreaks 'note this is a sheet-level setting


    'turn off some Excel functionality so your code runs faster


    Application.ScreenUpdating = False


    Application.DisplayStatusBar = False


    Application.Calculation = xlCalculationManual


    Application.EnableEvents = False


    ActiveSheet.DisplayPageBreaks = False 'note this is a sheet-level setting


    Dim rng As Range
    Dim r As Range
    Dim Lastrow As Long
    Dim Lastcol As Long
    Dim myRow As String
    Dim ColLtr As String


    myRow = Range("XFD3").End(xlToLeft).Address(False, False)


    ColLtr = Replace(Range("XFD3").End(xlToLeft).Address(False, False), "3", "")


    Lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    Lastcol = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column


    Set rng = Range("Gantt_Range") 'Intersect(Range("K4:" & ColLtr & Lastcol), Sheets("Sheet1 (2)").UsedRange)


'    rng.Select


    For Each r In rng


    Dim StartDate As Date
    Dim EndDate As Date
    Dim PlanDate As Date
    Dim CurrentDate As Date
    Dim myPerson As String


    StartDate = Range("I" & Range(r.Address).Row).Value
    EndDate = Range("J" & Range(r.Address).Row).Value
    ColLtr = Replace(Range(r.Address).Address(False, False), Range(r.Address).Row, "")
    PlanDate = Range(ColLtr & 3).Value
    myPerson = Left(Range("B" & Range(r.Address).Row).Value, 1)


    If PlanDate >= StartDate And PlanDate <= EndDate Then


    r.Value = myPerson
    r.NumberFormat = "General"
    r.Interior.Color = Range("B" & Range(r.Address).Row).Interior.Color


        If PlanDate = Range("Date_Current").Value Then
            Range(ColLtr & 3).Offset(0, -1).Interior.ColorIndex = xlColorIndexNone
            Range(ColLtr & 3).Offset(0, 1).Interior.ColorIndex = xlColorIndexNone
            Range(ColLtr & 3).Interior.Color = Range("Date_Current").Interior.Color
            r.Interior.Color = Range("Date_Current").Interior.Color
            Else
                'Range(ColLtr & 3).Interior.ColorIndex = xlColorIndexNone
        End If


        Else
        r.Value = ""
        r.NumberFormat = "General"
        r.Interior.ColorIndex = xlColorIndexNone


            If PlanDate = Range("Date_Current").Value Then
            Range(ColLtr & 3).Offset(0, -1).Interior.ColorIndex = xlColorIndexNone
            Range(ColLtr & 3).Offset(0, 1).Interior.ColorIndex = xlColorIndexNone
            Range(ColLtr & 3).Interior.Color = Range("Date_Current").Interior.Color
            r.Interior.Color = Range("Date_Current").Interior.Color
            Else
                'Range(ColLtr & 3).Interior.ColorIndex = xlColorIndexNone
            End If


    End If


    Next r


    'after your code runs, restore state


    Application.ScreenUpdating = screenUpdateState


    Application.DisplayStatusBar = statusBarState


    Application.Calculation = calcState


    Application.EnableEvents = eventsState


    ActiveSheet.DisplayPageBreaks = displayPageBreaksState 'note this is a sheet-level setting


End Sub

Display More

There is probably a more refined way to do this, perhaps try asking the rest of the Forum to either refine this code or come up with a better way. I have noticed that "jindon" has provided some better more refined solutions to some of my past posts perhaps see if he/she is willing to help.

Posts by Gizzmo

Populate Search Box and then Scrape Web Site for result

Error Object Required

VBA Return Count of PDF Files and...

VBA Return Count of PDF Files and...

Paste from multiple Excel workbooks into one workbook (Across the page & file names)

Paste from multiple Excel workbooks into one workbook (Across the page & file names)

Paste from multiple Excel workbooks into one workbook (Across the page & file names)

Paste from multiple Excel workbooks into one workbook (Across the page & file names)

Paste from multiple Excel workbooks into one workbook (Across the page & file names)

Formatting inputted number (190605) to cusstom date format

Formatting inputted number (190605) to cusstom date format

Using a selection from a list to poulate adjoining cells

A Total Count of All Records based on a Specific Year (i.e., 2014 or 2012) in Excel

A Total Count of All Records based on a Specific Year (i.e., 2014 or 2012) in Excel

A Total Count of All Records based on a Specific Year (i.e., 2014 or 2012) in Excel

New to Macros, Need help

New to Macros, Need help

Prevent returning value on a blank cell (=IF, True/False)

New to Macros, Need help

Project Plan with Gantt Chart and Resources Management