Posts by John_w

[cp]none[/cp]

I've never seen anything like that either. It seems to be a very clever way of thwarting automated web scraping because the Results 'table' isn't a HTML table with rows and columns, and neither is the data structured in a parent-child hierarchy that would be easy to parse.

Instead, the data values are arranged randomly in the HTML within < text > elements with the x and y attributes specifying the position of each data value.

What code have you tried so far?

Payment received, thanks.

Here is the code. It processes the data on the first sheet in the active workbook, so you must open your data workbook and have it as the active workbook and run the macro.

Public Sub Delete_Rows_With_Zero_Subtotal()


    Dim r As Long
    Dim p1 As Long, p2 As Long
    Dim Hcells As String


    Application.ScreenUpdating = False


    With ActiveWorkbook.Worksheets(1)
        r = .Cells(Rows.Count, "H").End(xlUp).Row
        While r > 0
            p1 = InStr(1, .Cells(r, "H").Formula, "=ROUND(SUM(", vbTextCompare)
            If p1 > 0 And .Cells(r, "H").Value = 0 Then
                p1 = p1 + Len("=ROUND(SUM(")
                p2 = InStr(p1, .Cells(r, "H").Formula, ")")
                Hcells = Mid(.Cells(r, "H").Formula, p1, p2 - p1)
                .Rows(r).EntireRow.Delete
                r = .Range(Hcells).Row - 1
                .Range(Hcells).EntireRow.Delete
            Else
                r = r - 1
            End If
        Wend
    End With


    Application.ScreenUpdating = True


    ActiveWorkbook.Save


    MsgBox "Done"


End Sub

The code is ready. I will send my payment details to you and on receipt will post the code here.

Thanks.

I can look at this.

Quote from LBR714

Not sure how to get the following code to be an integer to freeze the cells.

Code

Set frai = FoundCell.Row + 2
Rows("frai:frai").Select

Dim frai As Long  'Long, not Integer
    frai = FoundCell.Row + 2
    Rows(frai).Select

[cp]*[/cp]

Re: excel vba picture in cell to header

Welcome to Ozgrid forums.

I have several workbooks which use the Save_Object_As_Picture routine, and the code worked correctly when running Excel 2007 on a relatively slow Windows XP machine. However since upgrading to Excel 2016 and a fast (Intel i7 6700) Windows 10 machine I've found that the image/picture created by the code is empty.

The solution is to Activate the temporary chart, like this:

With temporaryChart
        .Activate                                'Required, otherwise image is blank with Excel 2016 or fast CPU (?)
        .Border.LineStyle = xlLineStyleNone      'No border
        .Chart.Paste
        .Chart.Export imageFileName
        .Delete
    End With

If you tell us which version of Excel and Windows you're using and your computer's CPU this will help to pinpoint the reason why the Activate is needed.

Re: Conditional syntax for 32-bit &amp; 64-bit Declare Statement

See http://www.jkp-ads.com/articles/apideclarations.asp and https://msdn.microsoft.com/en-…e691831(v=office.14).aspx

Re: Conditional syntax for 32-bit &amp; 64-bit Declare Statement

Try this:

Option Explicit


#If VBA7 Then
Private Declare PtrSafe Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpdwFlags As LongPtr, ByVal lpszConnectionName As String, ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Boolean
#Else
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Boolean
#End If


Sub X()


#If VBA7 Then
    Dim flags As LongPtr
#Else
    Dim flags As Long
#End If
    Dim sConnType As String * 255
    Dim result As Boolean
    
    result = InternetGetConnectedStateEx(flags, sConnType, LenB(sConnType), 0)


End Sub

Re: Run-time error '1004' in Pivot 10$

Here is your workbook with your original pivot field items intact and my macros added to Module1. I have added a MsgBox statement to show the FixPivotField macro deleting the pivot field item "54360".

https://drive.google.com/open?…6jC_48aIHdUTdLVVpJbzNpN2M

Run the FixPivotField macro.

Then run your UserForm1 from the VBA editor, enter 1234 in the input box and click Login. Your code now runs without error.

Re: Run-time error '1004' in Pivot 10$

Payment received, thanks.

The error displayed is:
[INDENT]Run-time error '1004':

Unable to get the PivotItems property of the PivotField class
[/INDENT]

If you click Debug on the error message the following VBA line is highlighted in yellow:

.PivotItems("54360").Visible = False

The error occurs because there are two pivot items named "54360", one with 298 records and one with 0 records. I don't know how to delete the zero item using the Excel GUI (only 1 "54360" item is shown in the "Cost Center" filter items list), so here is code which deletes the "54360" pivot item with 0 records:

Public Sub FixPivotField()


    Dim pitem As PivotItem
    
    With Sheet7.PivotTables("PivotTable7").PivotFields("Cost center")
        For Each pitem In .PivotItems
            If pitem.Name = "54360" And pitem.RecordCount = 0 Then
                pitem.Delete
            End If
        Next
    End With


End Sub

Put the above code in a standard module (not the UserForm1 module) and run the FixPivotField macro.

After running my macro, your userform code runs without error.

Here is more general code which deletes all pivot items in the "Cost center" pivot field which have 0 records.

Public Sub Delete_PivotField_Items_With_Zero_Records()


    Dim pitem As PivotItem
    
    With Sheet7.PivotTables("PivotTable7").PivotFields("Cost center")
        For Each pitem In .PivotItems
            If pitem.RecordCount = 0 Then
                Debug.Print pitem.Name, pitem.RecordCount
                On Error Resume Next  'trap error if more than one pivot item with same name has zero records
                pitem.Delete
                On Error GoTo 0
            End If
        Next
    End With


End Sub

On your posted workbook the above code found and deleted the pivot field named "(blank)" with 0 records. You can adapt the above code for other pivot tables and pivot fields by changing "PivotTable7" and "Cost center" as needed.

Edit: I said: "found and deleted the pivot field named "(blank)"". Actually, it doesn't delete it because the "(blank)" field it still there when you run the code again. It seems that the "(blank)" field can't be deleted.

Re: Run-time error '1004' in Pivot 10$

The fix is for the specific error and workbook you posted. I will provide a more general fix which you can adapt to fix other errors with the same error message which are caused by the same underlying problem.

Re: Run-time error '1004' in Pivot 10$

I have analysed the error and produced a fix. I'll PM my payment details and on receipt of payment will post the solution here.

Have you paid 10% of the fee to Ozgrid?

Re: Run-time error '1004' in Pivot 10$

Duplicate

Re: Macro for saving copy as csv with incremental file number

Try runnng the Save_CSV_Sheet macro in the attached workbook, which is your workbook changed to a macro-enabled workbook (.xlsm file).

forum.ozgrid.com/index.php?attachment/73742/

The file001.csv, file002.csv, etc. files are created in the same folder as the workbook.

Public Sub Save_CSV_Sheet()
    
    Dim csvFileName As String
    
    csvFileName = GetNextFileName(ThisWorkbook.Path & "\file<n>.csv")
     
    ThisWorkbook.Worksheets("CSV").Copy
    ActiveWorkbook.SaveAs csvFileName, FileFormat:=xlCSV
    ActiveWorkbook.Close False
    MsgBox "Saved CSV sheet as " & csvFileName
    
End Sub




Private Function GetNextFileName(filePath As String) As String
     
    Dim n As Integer
     
    n = 0
    Do
        n = n + 1
        GetNextFileName = Replace(filePath, "<n>", Format(n, "000"))
    Loop Until Dir(GetNextFileName) = vbNullString
     
End Function

Re: Macro for saving copy as csv with incremental file number

I haven't looked at your workbook. Here is a function which returns the next sequential file name, where the "<n>" in the string argument passed to it is replaced by 001, 002, etc.

Public Function GetNextFileName(filePath As String) As String


    Dim n As Integer
    
    n = 0
    Do
        n = n + 1
        GetNextFileName = Replace(filePath, "<n>", Format(n, "000"))
    Loop Until Dir(GetNextFileName) = vbNullString
    
End Function

Here's how to call it:

Public Sub Test()
    Dim csvFileName As String
    csvFileName = GetNextFileName("C:\folder\path\to\file<n>.csv")   'change folder path as necessary
    MsgBox "Next file name is " & csvFileName
End Sub

Re: Populate / Fill website form with data from excel rows ($45.00)

Payment received thank you very much. At fotodj's request I have sent a PM with a link to the workbook to him and SMC.

Re: Populate / Fill website form with data from excel rows ($45.00)

I have completed the coding and testing. I will send my payment details in a PM and on receipt of payment will post the workbook with macros.

Re: Populate / Fill website form with data from excel rows ($45.00)

SMC - thanks for the offer of your code, however I won't need it because I've got the whole thing working, including the file uploads.

As you've spent time on this task I think it is only fair that we share the remaining payment 50:50. Let me know if you're happy with this.