Posts by jo15765

I am wanting to use VBA to filter a worksheet. I am reading the userID's from the worksheet like this

Dim userID As Variant
Dim uID As Variant
userID = Sheets("Data").Range("B2:B101").Value

Then I try to do the below, to use VBA to filter it filters out all rows acting as if the value does not exist?

For Each uID In userID
    Sheets("Data").Range("$A$1:$BV$153").AutoFilter Field:=2, Criteria1:=userID
Next

Have I set up something improperly or are pivot tables exempt to the "Refresh All" option under the data tab in Excel 2013? I am having to manually refresh any and all pivot tables.

Re: Excel 2013 Inserting Dynamic Named Range

Quote from JohnCleary;770178

Go explore the tabs - Formulas/Name Manager.

I just did not imagine it would have been moved under Formulas. Thank you for that.

I know in Excel 2003 I would Do Insert --> Name --> Define but in Excel 2013 how do I input my formula to create a dynamic named range?

Re: Add Total Columns Through VBA

Derk that is exactly what I was needing. Is their a way to update the syntax so that it does borders like so:

'Borders
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .Weight = xlMedium

jindon helped me out greatly over on this thread http://www.ozgrid.com/forum/showthread.php?t=196736
but now I need to add a total to each sub sheet that is created, and add a total present column which counts the number of Xs from the Master sheet. Attached is a sample workbook showing my desired output on worksheet 1G. Attached is my current vba syntax (again provided by jindon not my own code) how would this be tweaked to add the 2 total columns like needed?

Sub test() 
    Dim a, i As Long, ii As Long, iii As Long, dic As Object 
    a = Sheets("all").[a3].CurrentRegion.Value 
    Set dic = CreateObject("Scripting.Dictionary") 
    dic.Comparemode = 1 
    For i = 3 To UBound(a, 1) 
        If Not dic.exists(a(i, 2)) Then 
            Set dic(a(i, 2)) = CreateObject("Scripting.Dictionary") 
        End If 
        For ii = 3 To UBound(a, 2) Step 8 
            If Not dic(a(i, 2)).exists(a(1, ii)) Then 
                Set dic(a(i, 2))(a(1, ii)) = CreateObject("Scripting.Dictionary") 
            End If 
            For iii = 0 To 7 
                If Not dic(a(i, 2))(a(1, ii)).exists(a(i, 1)) Then 
                    dic(a(i, 2))(a(1, ii))(a(i, 1)) = Empty 
                End If 
                If a(i, ii + iii) = "X" Then 
                    dic(a(i, 2))(a(1, ii))(a(i, 1)) = _ 
                    dic(a(i, 2))(a(1, ii))(a(i, 1)) + 1 
                End If 
            Next 
        Next 
    Next 
    SendToWS dic 
End Sub 
 
Private Sub SendToWS(dic As Object) 
    Dim e, i As Long, w 
    For Each e In dic 
        If Not IsSheetExists(CStr(e)) Then 
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = CStr(e) 
        End If 
        With Sheets(CStr(e)) 
            .Cells(1).CurrentRegion.Clear 
            .Cells(1, 2).Resize(, dic(e).Count).Value = dic(e).keys 
            .Cells(2, 1).Resize(dic(e).items()(1).Count).Value = _ 
            Application.Transpose(dic(e).items()(0).keys()) 
            For i = 0 To dic(e).Count - 1 
                If UBound(dic(e).items()(i).items) > -1 Then 
                    .Cells(2, 2 + i).Resize(dic(e).items()(i).Count).Value = _ 
                    Application.Transpose(dic(e).items()(i).items) 
                End If 
            Next 
            .Cells(1).CurrentRegion.Columns.AutoFit 
        End With 
    Next 
End Sub 
 
Function IsSheetExists(ByVal txt As String) As Boolean 
    On Error Resume Next 
    IsSheetExists = Len(Sheets(txt).Name) 
    On Error Goto 0 
End Function [/COLOR]

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

Re: VBA To Move Master Data To Secondary Sheets

That's it! Thank you thank you!

Re: VBA To Move Master Data To Secondary Sheets

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

Quote from jindon;756260

Working

AHHHH - I see what my problem is. I added a few dates to "ALL" worksheet, and it seems that if their is no "X" for the initials below the date it throws the erorr I received. See attachment (and this is a snippet, their will be multiple dates on the "ALL" worksheet that will not have any "X" added yet)

Re: VBA To Move Master Data To Secondary Sheets

Hello, and thank you for the prompt response! For me, it will create the 1st worksheet properly, then on this line I get a type mismatch error

]
Private Sub SendToWS(dic As Object)
.....
.Cells(2, 2+1).Resie(dic(e).items()(i).Count).Value=Application.Transpose(dic(e).items()(i).items)

So only the 1st "Sub" sheet is created.

I have a sheet called ALL and in column B each individual has been assigned a room number. For each unique room # I need to create a individual worksheet for. Then Take each individual name and deposit that into A2 going down of the corresponding worksheet. Then starting in A2 take each date found on the master sheet and SUM each of the X for the individual for that day. I have attached a sample book showing what I need, if someone could assist I will be indebted forum.ozgrid.com/index.php?attachment/66890/forum.ozgrid.com/index.php?attachment/66890/

Re: Sum Checked Checkboxes

Quote from mikerickson;756093

If the checkboxes are from the Forms menu, you could use code like

Code

Dim oneShape As Object
Dim CountOfCheckBoxes As Long
Dim CheckedBoxesCount As Long


For Each oneShape In ActiveSheet.Shapes
    If oneShape.Type = msoFormControl Then
        If oneShape.FormControlType = xlCheckBox Then
            CountOfCheckBoxes = CountOfCheckBoxes + 1
            If oneShape.ControlFormat.Value = xlOn Then
                CheckedBoxesCount = CheckedBoxesCount + 1
            End If
        End If
    End If
Next oneShape


MsgBox CheckedBoxesCount & " of " & CountOfCheckBoxes & " checkboxes are checked."

Display More

The nested IF statements cannot be combined into an AND because if the shape isn't msoFormControl, trying to read its .FormControlType will error.

Ah yes, that achieves the same goal as well. I should have done a little bit better explaining myself (or provided sample workbook). I have column A rows 2 - 80 with names in it and each name has checkboxes in columns B - whatever and I need a count for each row of what is checked / not checked.

Re: Sum Checked Checkboxes

Quote from shknbk2;756090

I'm not sure of your data, but a quick test of adding checkboxes and running this macro to set the linkedcell works. If you don't want the linked cell to be directly underneath the checkbox, you'll have to modify the code to offset the row_val and col_val values. Use the COUNTIF worksheet function to count the true values.

This code finds the row in which the top of the checkbox is in as well as the left side of the checkbox for its column.

Code

Sub setLinkedCells()
    Dim s As Shape
    Dim row_top As Long, row_val As Long
    Dim col_left As Long, col_val As Long
    
    For Each s In ActiveSheet.Shapes
        s.Select
        For col_left = 1 To 1000
            If s.Left > Columns(col_left).Left And s.Left < Columns(col_left + 1).Left Then
                col_val = col_left
                Exit For
            End If
        Next
        For row_top = 1 To 100
            If s.Top > Rows(row_top).Top And s.Top < Rows(row_top + 1).Top Then
                row_val = row_left
                Exit For
            End If
        Next
        If row_top > 0 And col_left > 0 Then
            Selection.LinkedCell = Cells(row_top, col_left).Address
            Selection.Value = Selection.Value
        End If
    Next s
End Sub

Display More

Ah yes, this is exactly what I was after. I didn't realize it was that labor intensive/time consuming to achieve this task, but it gets the job done. I am fine with the linked cell being under the checkbox. Is their a way to set the text to white so that you do not see True under a check, but I can still SumCountif from it?

I just inherited a spreadsheet that has roughly 1200 checkboxes on the sheet. I have googled and discovered that in order to get a count of the checks (or at least it appears) you must have the Cell link set. I have spot-checked around 100 of these and none have that value set.

1) is their a macro that will assign this value?
2) is their a way to count checked boxes w/o this being assigned?

What the spreadsheet looks like is C3:ZZ86 have checkboxes that are either checked or unchecked. And I need to have my sum of checked unchecked in A3 through etc.

I would also like for this to be done completely VBA free, well VBA can be done for the initial set-up, but moving forward if a check box is checked I want 1 to be added to the corresponding total.

Can someone please assist with this?

Re: Expand Column If #### Is Displayed

How would I auto-fit multiple columns?

In VBA is their a way to check columns E, R, Z, and AA and if they are showing ### expand the column?

Re: Copy Image From SourceWB To All WB's In A Directory

And just in case anyone ever needs this down the road, this is the full syntax I ended up going with.

Option Explicit
Public Sub OpenProdWB()
Dim MyFolder As String
Dim MyFile As String
    MyFolder = "C:\Test"
    'I only needed to update .xlsx files
    MyFile = Dir(MyFolder & "\*.xlsx")
    Do While MyFile <> ""
        Workbooks.Open Filename:=MyFolder & "\" & MyFile
        MyFile = Dir
        Call UpdateAllSheets
    Loop
End Sub
Public Function UpdateAllSheets()
Dim WS_Count As Integer
Dim I As Integer
Dim Shape As Shape
Dim image As Picture
Dim n As Integer
Dim t, l, h, w As Variant
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
    Sheets(I).Select
        With Sheets(I)
            For Each Shape In ActiveSheet.Shapes
                If (Shape.Name = "Picture 10" Or Shape.Name = "Picture 7") Then
                    Shape.Select
                    With Shape
                        t = .Top
                        l = .Left
                        h = .Height
                        w = .Width
                        .Delete
                    End With
                    ActiveSheet.Shapes.AddPicture Filename:="C:\new.jpg", linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=l, Top:=t, Width:=w, Height:=h
                End If
            Next
        End With
        Range("N1").Select
Next
On Error Resume Next
Sheets(1).Select
Range("N1").Select
On Error Resume Next
ActiveWorkbook.Save
On Error Resume Next
ActiveWorkbook.Close
End Function

Re: Copy Image From SourceWB To All WB's In A Directory

This is the syntax I ended up going with, not sure how exactly it differs from my above post, but this one is working! Thanks John_w

Debug.Print n
    With Sheets(1)
        For Each Shape In ActiveSheet.Shapes
            If (Shape.Name = "Picture 19" Or Shape.Name = "Picture 6") Then
                Shape.Select
                With Shape
                    t = .Top
                    l = .Left
                    h = .Height
                    w = .Width
                    .Delete
                End With
                ActiveSheet.Shapes.AddPicture Filename:="C:\New Template Footers\Image\footer.jpg", linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=l, Top:=t, Width:=w, Height:=h
            End If
        Next
    End With

Re: Copy Image From SourceWB To All WB's In A Directory

Alright, so I discovered that the Picture name from workbook to workbook is always one of two picture names, which helped simplify things. With my syntax here I am trying to assign the image (new logo) to the same dimensions of the old logo but the new image (new logo) is not imported with the same height/width specs of the old logo? Why is that?

Option Explicit
Public Sub LoopThroughPictures()
Dim Shape As Shape
Dim image As Picture
With Sheets(1)
    Set image = .Pictures.Insert("C:\nlg.jpg")
    For Each Shape In ActiveSheet.Shapes
        If (Shape.Name = "Picture 19") Then
            Shape.Select
            image.Left = Shape.Left
            image.Top = Shape.Top
            image.Width = Shape.Width
            image.Height = Shape.Height
        End If
    Next
End With
End Sub

Re: Copy Image From SourceWB To All WB's In A Directory

And if it makes a difference the destination workbooks will have about 2 Pictures and about 4 charts per page on them, if that changes syntax.

Re: Copy Image From SourceWB To All WB's In A Directory

Quote from John_w;751351

My first procedure showed how to do that. Get a reference to the image (specify workbook and sheet as necessary) and use its Width and Height properties.

PS - there, not their!

I tried this syntax, which is the cell directly above the Picture I want to get dimensions of, but it is not selecting nor deleting it? And the dimensions given are not for the image, I want to see...

Sub Getsum()




    With Sheet2
        .Activate
        .Range("A88").Select
        MsgBox Pictures(1).Height
        MsgBox Pictures(1).Width
        Pictures(1).Select
        Pictures(1).Delete
    End With








End Sub