Posts by Guinaba

Thanks alansidman, I have disable the query background refresh and my code is working now.

Hi experts,

I have the code below to refresh Powerquery and one pivot chart. It works however I have to run twice to be able to refresh both items. Any suggestion how to fix this issue?

Sub RefreshQueries_Click()
     ActiveWorkbook.Connections("Query - qryAldiScanData").Refresh   
'     Application.Wait (Now + TimeValue("0:00:05")) 
  Call RefreshData    
End Sub

Sub RefreshData()
    Sheets("Graph").PivotTables("PivotTable1").PivotCache.Refresh
    ThisWorkbook.RefreshAll    
End Sub

Find a easier solution replacing WeekNumber per first day of the week so Excel understand the timeseries

Hi guys,

I am trying to find a way to organize the columns of my sheet in ascending order, these columns are a mix of week/year and month/year and they are dynamic, changing every week. I could use the code below, but the problem is when the header changes the code stop working. Any suggestion?

Sub Reorder_Columns()
Dim ColumnOrder As Variant, ndx As Integer
Dim Found As Range, counter As Integer
ColumnOrder = Array("Header 6", "Header 2", "Header 1", "Header 4", "Header 5", "Header 3")
counter = 1
Application.ScreenUpdating = False
For ndx = LBound(ColumnOrder) To UBound(ColumnOrder)
Set Found = Rows("1:1").Find(ColumnOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not Found Is Nothing Then
If Found.Column <> counter Then
Found.EntireColumn.Cut
Columns(counter).Insert Shift:=xlToRight
Application.CutCopyMode = False
End If
counter = counter + 1
End If
Next ndx
Application.ScreenUpdating = True
End Sub

Hi guys,



I using this code to copy a snapshot of sheet(1), renaming considering today's date and pasting as the last sheet in the workbook. However not sure how to break the pivot table link with datasource, making it not refreshable. Any suggestion,please?

Sub CopySheetRename()
             Dim S_ As Date
             Application.ScreenUpdating = False
             If RangeExists("Snapshot " & Format(Date, "dd-mmm-yyyy")) Then
                MsgBox "Sheet already exists."
             Else
                Sheets(1).Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = "Snapshot " & Format(Date, "dd-mmm-yyyy")
            End If
               Application.ScreenUpdating = True
          End Sub

Function RangeExists(WhatSheet As String, Optional ByVal WhatRange As String = "A1") As Boolean
    Dim test As Range
    On Error Resume Next
    Set test = ActiveWorkbook.Sheets(WhatSheet).Range(WhatRange)
    RangeExists = Err.Number = 0
    On Error GoTo 0
End Function

I have two arrays:

RawData Array: having the raw data

Calc Array: having the transformed data

In the Calc array the column DEM needs to be summed grouping the data by column MTHID. Any suggestions, please.

Code:

Sub AddCalc()

Dim RawData() As Variant

Dim Calc() As Variant

Dim Dim1 As Long, Counter As Long

Sheet2.Activate

'Add data range into the RawData array

RawData = Range("A2", Range("A2").End(xlDown).End(xlToRight))

Dim1 = UBound(RawData, 1)

Dim2 = UBound(RawData, 2)

ReDim Calc(1 To Dim1, 1 To Dim2)

For Counter = 1 To Dim1

Calc(Counter, 1) = RawData(Counter, 3)

Calc(Counter, 2) = RawData(Counter, 16)

Calc(Counter, 3) = RawData(Counter, 17)

Calc(Counter, 4) = RawData(Counter, 6)

Next Counter

Worksheets.Add

Range("A2", Range("A2").Offset(Dim1, 3)).Value = Calc

[A1:D1] = [{"SKUCODE","MONTHYEAR","MTHID","DEM"}]

Erase RawData

Erase Calc

End Sub

Table:

Hi experts,

Not sure why I am getting different results when calculating standard deviation in Excel and DAX using the same data sample.

In Excel using STDEV.S(C9:N9) the result is 2176

Using DAX function STDEVX.S the result is 342

STD (12mth):=STDEVX.S(RawData,CALCULATE([Mth1]+[Mth2]+[Mth3]+[Mth4]+[Mth5]+[Mth6]+[Mth7]+[Mth8]+[Mth9]+[Mth10]+[Mth11]+[Mth12])) = 342

Gilly

Hi experts,

Before adding values into column K, I need to delete the previous records. I have created a for loop to go through the col. K range to check whether the cells are empty if not clear the content, but not sure why is not working.

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Dim rng As Range, cell As Range
Set rng = Range("K2", Range("K2").End(xlDown))

DaysToMRPDate = TextBox1.Value
If DaysToMRPDate = "" Then
Exit Sub
End If

'Selecting the correct sheet
Worksheets("MRPReqLive").Activate

'Filter all the Purchase Order <> 0
ActiveSheet.Range("a1", ActiveSheet.Range("a1").End(xlDown)).AutoFilter Field:=5, Criteria1:="<>0", _
Operator:=xlAnd

'Looping through the column AddDayFactor to clear previous data records

For Each cell In rng

If IsEmpty(cell.Value) = False Then
cell.Value = 0
End If

Next cell



'Copy the value from the user form into the AddDayFactor
Range("K2", Range("K2").End(xlDown)).Value = TextBox1.Value

'Remove filter
ActiveSheet.Range("a1", ActiveSheet.Range("a1").End(xlDown)).AutoFilter Field:=5

'Refreshing worksheet
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

Worksheets("MRPReqPivot").Activate

MsgBox ("Data is added successfully")

Call PivotMacro

Call ChangeCharts

Application.ScreenUpdating = True

End Sub

Thanks hips KjBox It is working now!! Awesome!!

Hi KjBox,

Thanks for replying, actually I am using two option buttons to populate the ChartName parameter. Though not sure why the code work only for the first chart (Chart2wks)) and when I select the other chart (Chart3wks) I keep getting the error:

Runtime Error 481; Invalid Picture

Set
CurrentChart = ThisWorkbook.Sheets("Charts").ChartObjects(ChartName).Chart

2 wks coverage option button

Private Sub Opt2WksCov_Click()

Call ChangeChart("Chart2wks")

End Sub

3 wks coverage option button

Private Sub Opt3WksCov_Click()

Call ChangeChart("Chart3wks")

End Sub

Sub ChangeChart (ChartName As String)

Dim CurrentChart As Chart

Dim FName As String

FName = ThisWorkbook.Path & "\temp.gif"

Set CurrentChart = ThisWorkbook.Sheets("Charts").ChartObjects(ChartName).Chart

CurrentChart.Export Filename:=FName, filtername:="GIF"

FormCharts.ImgChart.Picture = LoadPicture(FName)

End Sub

Hi experts,

I am trying to show a PivotChart in a userform using the code below:

Sub ChangeChart (ChartName As String)
    Dim CurrentChart As Chart
    Dim FName As String

    FName = ThisWorkbook.Path & "\temp.gif"
    Set CurrentChart = ThisWorkbook.Sheets("Charts").ChartObjects(ChartName).Chart

    CurrentChart.Export Filename:=FName, filtername:="GIF"
    frmCharts.imgChart.Picture = LoadPicture(FName)

End Sub

However, I am getting the below error msg:

Run-time error - The item with the specified name wan't found

I believe I am using the incorrect object (chart) but not sure how to add a pivot chart in the line code.

Appreciate any help.

Thank you Kenneth!! You are a legend!!

Hi experts,

Someone could help me to use inputbox variables to populate the data to be used in this function.

Function Cover (Stock As Double, Sales As Range) As Double

s = Stock
c = 0

For Each sale In Sales.Cells
If s = 0 Then Exit For
If s >= Val(sale.Value) Then
c = c + 1
s = s - Val(sale.Value)
Else
c = c + s / Val(sale.Value)
s = 0
Exit For
End If
Next

If s > 0 Then c = 9999

Cover = c

End Function

Cheers,

Gilly

Awesome!! That is perfect! Thanks a lot!!

Hi experts,

The code below groups data by agent name and the total revenue generated by each agent. However I need to include a date column in this table and use this column in my group condition as well, so as result and should have the table 2:

Could someone help me to include the second condition in my inverse loop.

Sub DataGrouping()


'Declaring variables
Dim Rng As Range
Dim LngRow As Long, LngLastRow, i As Long


Application.ScreenUpdating = False


'Getting row number of last cell
LngLastRow = Cells(Rows.Count, 1).End(xlUp).Row


'Initializing the first row
i = 2


'Looping until blank cell is encountered in first column
While Not Cells(i, 1).Value = ""


'Initializing range object
Set Rng = Cells(i, 2)




'Looping from last row to specified first row
For LngRow = LngLastRow To (i + 1) Step -1
Checking whether value in the cell is equal to specified cell
If Cells(LngRow, 1).Value = Rng.Value Then
Rng.Offset(0, 2).Value = Rng.Offset(0, 2).Value + Cells(LngRow, 3).Value
Rows(LngRow).Delete
End If
Next LngRow


i = i + 1


Wend


Application.ScreenUpdating = True


End Sub

[TABLE="border: 1, cellpadding: 1, width: 500"]

Table 1
Before running the macro: [TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 319"]

Name

Phone

Sales/Call

Guy

1-565-498-6512

$1.00

John

1-565-498-6513

$1.00

Mary

1-565-498-6514

$1.00

Ted

1-565-498-6515

$1.00

Guy

1-565-498-6512

$1.00

John

1-565-498-6513

$1.00

Mary

1-565-498-6514

$1.00

Ted

1-565-498-6515

$1.00

Guy

1-565-498-6512

$1.00

John

1-565-498-6513

$1.00

Mary

1-565-498-6514

$1.00

Ted

1-565-498-6515

$1.00

Guy

1-565-498-6512

$1.00

John

1-565-498-6513

$1.00

Mary

1-565-498-6514

$1.00

Ted

1-565-498-6515

$1.00

[/TABLE]

[TABLE="border: 1, cellpadding: 0, cellspacing: 0"]

Table 1
After running the macro: [TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 319"]

Name

Phone

Sales/Call

Guy

1-565-498-6512

$4.00

John

1-565-498-6513

$4.00

Mary

1-565-498-6514

$4.00

Ted

1-565-498-6515

$4.00

[/TABLE]

[/TABLE]

Table 2
Before running the macro: [TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 397"]

Name

Date

Phone

Sales/Call

Guy

7/05/2018

1-565-498-6512

$1.00

John

7/05/2018

1-565-498-6513

$1.00

Mary

7/05/2018

1-565-498-6514

$1.00

Ted

7/05/2018

1-565-498-6515

$1.00

Guy

7/05/2018

1-565-498-6512

$1.00

John

7/05/2018

1-565-498-6513

$1.00

Mary

7/05/2018

1-565-498-6514

$1.00

Ted

7/05/2018

1-565-498-6515

$1.00

Guy

8/05/2018

1-565-498-6512

$1.00

John

8/05/2018

1-565-498-6513

$1.00

Mary

8/05/2018

1-565-498-6514

$1.00

Ted

8/05/2018

1-565-498-6515

$1.00

Guy

9/05/2018

1-565-498-6512

$1.00

John

9/05/2018

1-565-498-6513

$1.00

Mary

9/05/2018

1-565-498-6514

$1.00

Ted

9/05/2018

1-565-498-6515

$1.00

[/TABLE]

Table 2
After running the macro: [TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 345"]

Name

Date

Phone

Sales/Call

Guy

7/05/2018

1-565-498-6512

$2.00

John

7/05/2018

1-565-498-6513

$2.00

Mary

7/05/2018

1-565-498-6514

$2.00

Ted

7/05/2018

1-565-498-6515

$2.00

Guy

8/05/2018

1-565-498-6512

$1.00

John

8/05/2018

1-565-498-6513

$1.00

Mary

8/05/2018

1-565-498-6514

$1.00

Ted

8/05/2018

1-565-498-6515

$1.00

Guy

9/05/2018

1-565-498-6512

$1.00

John

9/05/2018

1-565-498-6513

$1.00

Mary

9/05/2018

1-565-498-6514

$1.00

Ted

9/05/2018

1-565-498-6515

$1.00

[/TABLE]

[/TABLE]
Cheers,
Gilly

Hi experts,

I am using the below code to copy and paste charts into a PowerPoint presentation, however I would like to paste in the correct (height and width). I am using PasteSpecial to paste but not sure how to position the pic.

Sub ExceltoPowerPoint()

Dim PowerPointApp As Object
Dim myPresentation As Object

Set PowerPointApp = GetPowerPointApp()
Set myPresentation = PowerPointApp.Presentations.Add

Call createPlanOverviewSlide(myPresentation, ThisWorkbook.ActiveSheet.Range("B3:N30"))

PowerPointApp.Visible = True
PowerPointApp.Activate

Application.CutCopyMode = False




Sub createPlanOverviewSlide(ByVal myPresentation As Object, ByRef rng As Range)

'Create new slide------------------------------------------------------------------------------------------------------

Set myslide = myPresentation.Slides.Add(myPresentation.Slides.Count + 1, 12) '11 = ppLayoutTitleOnly

'Copy range and paste to powerpoint------------------------------------------------------------------------------------

rng.Copy
myslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile

End Sub

Hi experts,

I am using the following VBA to export my worksheet to PowerPoint file, however if I change the slicer in my Pivot Chart and export again the worksheet, the code is creating a new presentation. I would like to add the new selection using the same presentation, just adding as a new slide.

Any suggestions, please.

*******************************************************************************************************************************************************************************************************************************************************************************************************

VBA Code:

Sub ExceltoPowerPoint()

Dim PowerPointApp As Object
Dim myPresentation As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim namecheck As Range

Set PowerPointApp = GetPowerPointApp()
Set myPresentation = PowerPointApp.Presentations.Add

Call ExportResourcePlanSlide(myPresentation, ThisWorkbook.ActiveSheet.Range("a2:m40"))

PowerPointApp.Visible = True
PowerPointApp.Activate

Application.CutCopyMode = False

End Sub

Function GetPowerPointApp() As Object

On Error Resume Next
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
Err.Clear
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Function
End If
Set GetPowerPointApp = PowerPointApp
On Error GoTo 0

End Function

Sub ExportResourcePlanSlide(ByVal myPresentation As Object, ByRef rng As Range)

'Create new slide------------------------------------------------------------------------------------------------------

Set myslide = myPresentation.Slides.Add(myPresentation.Slides.Count + 1, 12) '11 = ppLayoutTitleOnly

'Copy range and paste to powerpoint------------------------------------------------------------------------------------

rng.Copy
myslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile

'Add Commentary Text Box-----------------------------------------------------------------------------------------------

Set myTextBox = myslide.Shapes.AddTextbox(1, Left:=100, Top:=100, Width:=8.19 * 28.3465, Height:=350)

With myTextBox
.TextFrame.TextRange.Text = ""
.TextFrame.TextRange.Font.Size = 10
.Left = 24.9 * 28.3465
.Top = 3.18 * 28.3465
End With

End Sub

Hello

I've created an Excel 2016 User Form (UserForm1), and within that form, an image control (Image1). Using VBA, I can load images into the image control from a FILE, but I have not been able to load images from a Website (sharepoint)

Private Sub CboMember_Change()


On Error Resume Next


If cboMember.Value <> "" Then
       
         Me.Image1.Picture = LoadPicture("C:\Users\gbar\OneDrive - Ton Pty Ltd\Snagit" & cboMember.Value & ".JPG" & cboMember.Value & ".JPG")
    
        End If


Exit Sub


End Sub

Here's the code that doesn't work... Any solutions?

Cheers,
Gilly

Awesome! Thanks so much Ken! Much appreciate it! It works perfectly!

Hi Ken,

Thanks for your help! I have att. the file. Sheet1 is the data sheet (read/copy from) and the Sheet2 is the report sheet (past to) which needs a specific format.

Cheers,

Gilly