Posts by Bah73

Bah73 · Aug 29th 2023

Hi,

I have a macro enabled workbook and occasionally I open the workbook and get an error message requiring a repair to the workbook.

Does anyone know what this is?

Code

<recoveryLog xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main">
<logFileName>error344480_01.xml</logFileName>
<summary>Errors were detected in file 'D:\Files\Planner\Planner Tool.xlsm'</summary>
<removedRecords>
<removedRecord>Removed Records: Sorting from /xl/tables/table31.xml part (Table)</removedRecord>
</removedRecords>
</recoveryLog>

Bah73 · Aug 18th 2023

Thanks Rory

Following your advice I came up with the following working code

Allowing me to reference several sheet code names and tables from the active sheet.

Code

Sub TEST()
    
    Dim WS As Worksheet
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim TB1 As ListObject
    Dim TB2 As ListObject
    Dim Value1 As String
    Dim Value2 As String
    
'Set Values
    Set WS1 = ActiveSheet
    Value1 = WS1.Range("P1").Value
    Value2 = WS1.Range("O1").Value
    
'Set WS1
    For Each WS In Worksheets
        If WS.CodeName = Value1 Then
        WS.Select
        Set WS1 = ActiveSheet
        End If
    Next WS
    
'Set WS2
    For Each WS In Worksheets
        If WS.CodeName = Value2 Then
        WS.Select
        Set WS2 = ActiveSheet
        End If
    Next WS

'Set Tables
    Set TB1 = WS1.ListObjects(Value1)
    Set TB2 = WS2.ListObjects(Value2)
    
'Test
    WS1.Range("O2").Value = "Test1"
    WS2.Range("O2").Value = "Test2"
 
End Sub

Display More

Bah73 · Aug 17th 2023

Hi,

I am trying to reference a sheet and table (both have the same name) by using the sheets code name and table name that i have in cell "A1"

I am currently getting a Compile Error: Type Mismatch

Any help appreciated thanks

Code

Sub TEST()

    Dim WS1 As Worksheet
    Dim TB1 As ListObject
    Dim Value1 As String
    
'Set Value
    Set WS1 = ActiveSheet
    Value1 = WS1.Range("A1").Value
    
'Set Worksheet Codename
    Set WS1 = Value1
    
'Set Table
    Set TB1 = WS1.ListObjects(Value1)

End Sub

Display More

Bah73 · Mar 24th 2023

Thanks Carim

Bah73 · Mar 24th 2023

Thanks Carim,

Basically I am applying a column filter then adding a value to an adjacent column

I problem I am having is when the filter returns no value the code still adds a value to the adjacent column

This creates a new task line

The code I need help with is if the filter returns no values to skip to next filter block

I cannot upload a Project file so have added some code below

Code

'''''Examples of a filter returning no value and adding format and text to adjacent column creating a new task
'''''When filter returns no value I need to skip to next set of code

'''''Skip if no value returned 
    SetAutoFilter FieldName:="Text30", FilterType:=pjAutoFilterCustom, Test1:="contains", Criteria1:="ALS"
    SetAutoFilter FieldName:="Resource Names", FilterType:=pjAutoFilterIn, Criteria1:="PC-CPINSP"
    SelectTaskColumn Column:="Text3"
    Font32Ex CellColor:=13159680
    SetTaskField Field:="Text3", Value:="CLASSIFIED"
    FillDown
    FilterClear
     

'''''Skip if no value returned   
    SetAutoFilter FieldName:="Text30", FilterType:=pjAutoFilterCustom, Test1:="contains", Criteria1:="ALS"
    SetAutoFilter FieldName:="Resource Names", FilterType:=pjAutoFilterIn, Criteria1:="PC-CRNINSP"
    SelectTaskColumn Column:="Text3"
    Font32Ex CellColor:=13159680
    SetTaskField Field:="Text3", Value:="Crane"
    FillDown
    FilterClear
    
    
'''''Skip if no value returned     
    SetAutoFilter FieldName:="Text30", FilterType:=pjAutoFilterCustom, Test1:="contains", Criteria1:="ALS"
    SetAutoFilter FieldName:="Resource Names", FilterType:=pjAutoFilterIn, Criteria1:="PC-DRONE"
    SelectTaskColumn Column:="Text3"
    Font32Ex CellColor:=13159680
    SetTaskField Field:="Text3", Value:="Drone"
    FillDown
    FilterClear

Display More

Bah73 · Mar 24th 2023

Hi

Is anyone able to point me in the right direction on where to get help with some MS Project VBA code?

Bah73 · Jan 14th 2023

Yes thanks work perfectly.

Bah73 · Jan 14th 2023

For the final touch I added this to the sheet module where the chart is located.

Now every time I open the sheet to view the chart the transpose data and pivot table data update automatically.

Does anyone know why I was getting the @ symbol in my formula if I was trying to insert it with VBA?

See first post.

Code

Private Sub Worksheet_Activate()
Call Refresh_Chart
End Sub

Bah73 · Jan 13th 2023

All good Carim I figured out how to use the code you supplied.

The transposed data is used to create a pivot table for a chart.

I created button with a refresh all code including your code and so every time I refresh the chart the transpose data updates.

Code

Sub Refresh_Chart()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim WS1 As Worksheet
    Set WS1 = Worksheets("Labour Chart")
    
    WS1.Range("A2:F1092").Value = WorksheetFunction.Transpose(Sheets("MOH Chart").Range("M2:APK7"))

    ThisWorkbook.RefreshAll
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   
End Sub

Display More

Bah73 · Jan 13th 2023

Thanks Carim,

That code works but it only transposes the values and doesn't insert the formula into the cell.

This is a problem because when the main sheet data is updated the transposed data don't update with it.

Bah73 · Jan 13th 2023

Yes, that sounds right.

Bah73 · Jan 13th 2023

No I didn't solve the problem for that one.

The work around I used was to reference a range that would be greater than last would ever be.

Like below

I will try your code tonight when I get home.

Code

WS1.Range("M4").Formula = "=SUM(M8:M1000)"

Bah73 · Jan 13th 2023

Thanks Carim,

MOH Chart is the sheet name where the data is.

Bah73 · Jan 13th 2023

Hi Carim Thanks, sorry haven't been on this forum for a while.

Bah73 · Jan 13th 2023

Hi,

I am trying to inset a formula with VBA, and I am getting the following result.

The formula I want is =TRANSPOSE('MOH Chart'!M2:APF7)

The result I am getting is =@TRANSPOSE(@'MOH Chart'!M2:APF7)

My code is below.

Can anyone please help?

Code

 WS1.Range("A2").Formula = "=TRANSPOSE('MOH Chart'!M2:APF7)"

Bah73 · Nov 9th 2022

Hi,

Can anyone please help me with this

I am trying to insert a formula with a Last Row Address reference, and I can't get the wording correct on (M8:LastR)

Code

LastR = Range("M" & Cells(Rows.Count, "M").End(xlUp).Row).Address
WS1.Range("M4").Formula = "=SUM(M8:LastR)"

Bah73 · Dec 16th 2021

Thanks KjBox that works awesome

Is there any way to name the sheets instead of sheets(1) and Sheets(2)?

ie

Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Worksheets("Base")
Set WS2 = Worksheets("Comments")

Bah73 · Dec 15th 2021

Ok will do tomorrow thanks.

Bah73 · Dec 15th 2021

No that combination creates a unique value.

Bah73 · Dec 15th 2021

Hi,

I have a Transfer Data loop that runs very slow.

Is there any way to make this more efficeint?

Code

Sub Transfer_Comments()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim Last As Long
    Dim i As Long
    Dim j As Long
    
    Set WS1 = Worksheets("Sheet 1")
    Set WS2 = Worksheets("Sheet 2")
  
'Transfer Comments
    For i = 1 To WS1.Cells(WS1.Rows.Count, 2).End(xlUp).Row
    For j = 1 To WS2.Cells(WS2.Rows.Count, 2).End(xlUp).Row
        If WS1.Cells(i, 11).Value2 = WS2.Cells(j, 11).Value2 And WS1.Cells(i, 14).Value2 = WS2.Cells(j, 14).Value2 Then
            WS1.Cells(i, 10).Value = WS2.Cells(j, 10).Value
            WS1.Cells(i, 22).Value = WS2.Cells(j, 22).Value
        End If
    Next j
    Next i

    WS2.Delete
    
    Set WS1 = Nothing
    Set WS2 = Nothing
  
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Display More

Posts by Bah73

Sorting Table Error

Reference Sheet By Code Name From Cell Value

Reference Sheet By Code Name From Cell Value

Trap when Filter returns nothing

Trap when Filter returns nothing

Trap when Filter returns nothing

Insert formula with a Last Row Address reference

VBA Insert formula not working.

VBA Insert formula not working.

VBA Insert formula not working.

VBA Insert formula not working.

Insert formula with a Last Row Address reference

VBA Insert formula not working.

Insert formula with a Last Row Address reference

VBA Insert formula not working.

Insert formula with a Last Row Address reference

Transfer Data Loop

Transfer Data Loop

Transfer Data Loop

Transfer Data Loop